Microsoft Office Forums Auto fill based on previous entry

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 11-22-2019, 06:09 AM
geojf3 geojf3 is offline Auto fill based on previous entry Windows 10 Auto fill based on previous entry Office 2010
Novice
Auto fill based on previous entry
 
Join Date: Nov 2019
Posts: 6
geojf3 is on a distinguished road
Default Auto fill based on previous entry

There are currently hundreds of documents that need to be updated, there is a master document that is opened and then saved as a new document. They each have a table on page 2 that can contain an X in one of 636 boxes (60x14 minus the header row and column). Based on the placement of the X, a description goes into a table (22x4 minus the header row and column) starting on page 4. The descriptions are stored in another word document.

I am looking to process each document, find the X's in the designated areas, get the description from the other word document and populate the table area in the existing document.


Any help would be appreciated.

Last edited by geojf3; 11-22-2019 at 07:53 AM. Reason: Change of description
Reply With Quote
  #2  
Old 11-22-2019, 09:09 AM
geojf3 geojf3 is offline Auto fill based on previous entry Windows 10 Auto fill based on previous entry Office 2010
Novice
Auto fill based on previous entry
 
Join Date: Nov 2019
Posts: 6
geojf3 is on a distinguished road
Default

I created a macro with the following code to read through the first table and if there is an X, place data in the second table.


What I do not know how to do is have it run for all the documents that need to be changed/updated.


Code:
Dim strClean As String
Dim oTbl As Table
Dim Row As Integer
Dim Col As Integer
Dim strCellText As String

Set oTbl = ActiveDocument.Tables(3)

 For Row = 1 To oTbl.Rows.Count
        For Col = 1 To oTbl.Columns.Count
            strCellText = oTbl.Cell(Row, Col).Range.Text
            strClean = Mid(strCellText, 1, Len(strCellText) - 2)
            If Trim(strClean) = "X" Then
               With ActiveDocument.Tables(4).Cell(2, 3).Range
               .Text = "nailed it"
               End With
            End If
        Next
    Next
Reply With Quote
  #3  
Old 11-23-2019, 01:57 AM
gmayor's Avatar
gmayor gmayor is online now Auto fill based on previous entry Windows 10 Auto fill based on previous entry Office 2016
Expert
 
Join Date: Aug 2014
Posts: 3,029
gmayor is just really nicegmayor is just really nicegmayor is just really nicegmayor is just really nicegmayor is just really nice
Default

Notwithstanding that your 'master' document should be a template from which new documents are created rather than saved with a new name, you need to run your code with a batch process that opens all the appropriate documents and runs your code. You should also introduce some error handling to at least ensure that there are four tables or more in the documents. The following will work as a custom process with Document Batch Processes which will handle the files and folders.

Code:
Function ProcessTables(oDoc As Document) As Boolean
Dim oTbl As Table
Dim Row As Integer
Dim Col As Integer
Dim oCell As Range
Dim strCellText As String
    On Error GoTo err_Handler

    If oDoc.Tables.Count > 3 Then
        Set oTbl = oDoc.Tables(3)
        For Row = 1 To oTbl.Rows.Count
            For Col = 1 To oTbl.Columns.Count
                Set oCell = oTbl.Cell(Row, Col).Range
                oCell.End = oCell.End - 1
                strCellText = oCell.Text
                Set oCell = oDoc.Tables(4).Cell(2, 3).Range
                oCell.End = oCell.End - 1
                If Trim(strCellText) = "X" Then
                    oCell.Text = "nailed it"
                    Exit For
                    Exit For
                End If
            Next Col
        Next Row
        ProcessTables = True
    End If
lbl_Exit:
    Exit Function
err_Handler:
    ProcessTables = False
    Resume lbl_Exit
End Function
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #4  
Old 11-23-2019, 06:51 AM
geojf3 geojf3 is offline Auto fill based on previous entry Windows 10 Auto fill based on previous entry Office 2010
Novice
Auto fill based on previous entry
 
Join Date: Nov 2019
Posts: 6
geojf3 is on a distinguished road
Default

Thats works great...thank you!
Reply With Quote
  #5  
Old 11-24-2019, 07:44 AM
geojf3 geojf3 is offline Auto fill based on previous entry Windows 10 Auto fill based on previous entry Office 2010
Novice
Auto fill based on previous entry
 
Join Date: Nov 2019
Posts: 6
geojf3 is on a distinguished road
Default

Below is the full code I have come up with. I am having an issue when the error trap executes. Once the error is displayed it resumes to get the next file in the folder, but oDoc3 is somehow closed - I get an error indicating "Object has been deleted". This will work fine if I only use on file to update - oDoc2 stays open.

Any ideas as to why that one document reference disappears?



Code:
Sub BatchProcess()

Dim strFile As String
Dim strPath As String
Dim oDoc As Document

Dim strFile2 As String
Dim strPath2 As String
Dim oDoc2 As Document

Dim strFile3 As String
Dim strPath3 As String
Dim oDoc3 As Document

Dim fDialog As FileDialog

'Get document path for documents to be updated
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDialog
        .Title = "Select Folder To Be Processed"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then
            MsgBox "Update Cancelled By User", , "List Folder Contents"
            Exit Sub
        End If
        strPath = fDialog.SelectedItems.Item(1)
        Do Until Right(strPath, 1) = "\"
            strPath = strPath + "\"
        Loop
    End With
    
'Get document path for decision language document
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .Title = "Select File To Be Used As Decision Language Source"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then
            MsgBox "Update Cancelled By User", , "List Folder Contents"
            Exit Sub
        End If
        strPath2 = fDialog.SelectedItems.Item(1)
        'Do Until Right(strPath2, 1) = "\"
        '    strPath2 = strPath2 + "\"
        'Loop
    End With
    
'Get document path for complaint language document
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .Title = "Select File To Be Used As Complaint Language Source"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then
            MsgBox "Update Cancelled By User", , "List Folder Contents"
            Exit Sub
        End If
        strPath3 = fDialog.SelectedItems.Item(1)
        'Do Until Right(strPath2, 1) = "\"
        '    strPath2 = strPath2 + "\"
        'Loop
    End With
    
    Set oDoc2 = Documents.Open(strPath2)
    Set oDoc3 = Documents.Open(strPath3)
    
    strFile = Dir$(strPath & "*.docx")
    While strFile <> ""
        Set oDoc = Documents.Open(strPath & strFile)
        ICD10_Update oDoc, oDoc2, oDoc3
        oDoc.Close SaveChanges:=wdSaveChanges
        strFile = Dir$()
    Wend
    oDoc2.Close
    oDoc3.Close
    
lbl_Exit:
    Exit Sub

End Sub

Private Sub ICD10_Update(MainDoc As Document, DecisionsDoc As Document, ComplaintDoc As Document)

'table 3 = diagnosis
'table 4 = Medical Decision Making
'cell (2,3) = row 2, column 3

Dim strClean As String
Dim oTbl As Table
Dim Row As Integer
Dim Col As Integer
Dim strCellText As String
Dim ICD As String
Dim ICDLoc As String
Dim msg As String
Dim DecisionCount As Integer
Dim ComplaintCount As Integer

On Error Resume Next
Set oTbl = MainDoc.Tables(4)
If Err.Number = 5941 Then
   msg = "Required table not found in " + MainDoc.Name
   MsgBox msg, , "Document Error"
   Exit Sub
End If
On Error GoTo 0

DecisionCount = 0
ComplaintCount = 0

 For Row = 1 To (oTbl.Rows.Count - 1)  'Dont write in last row
        For Col = 1 To oTbl.Columns.Count
            strCellText = oTbl.Cell(Row, Col).Range.Text
            strClean = Mid(strCellText, 1, Len(strCellText) - 2)
            If UCase(Trim(strClean)) = "X" Then
               ICD = oTbl.Cell(Row, 1).Range.Text
               ICDLoc = oTbl.Cell(Row, 2).Range.Text
               DecisionCount = DecisionCount + 1
               If DecisionCount <= (oTbl.Rows.Count - 1) Then
                  Call UpdateDecision(Mid(ICD, 1, Len(ICD) - 2), Mid(ICDLoc, 1, Len(ICDLoc) - 2), MainDoc, DecisionsDoc, DecisionCount)
               End If
               ComplaintCount = ComplaintCount + 1
               If ComplaintCount <= (oTbl.Rows.Count - 1) Then
                  Call UpdateComplaint(Mid(ICD, 1, Len(ICD) - 2), Mid(ICDLoc, 1, Len(ICDLoc) - 2), MainDoc, ComplaintDoc, ComplaintCount)
               End If
               
               Exit For
            End If
        Next
    Next

End Sub

Private Sub UpdateDecision(inText1 As String, inText2 As String, MainDoc As Document, DecisionDoc As Document, DecisionCount As Integer)
   
Dim strClean As String
Dim oTbl2 As Table
Dim Row2 As Integer
Dim Col2 As Integer
Dim strCellText As String

Set oTbl2 = DecisionDoc.Tables(1)
   
 For Row2 = 1 To oTbl2.Rows.Count
        For Col2 = 1 To oTbl2.Columns.Count
            strCellText = oTbl2.Cell(Row2, Col2).Range.Text
            strClean = Mid(strCellText, 1, Len(strCellText) - 2)
            If Trim(strClean) = inText1 Then
                MainDoc.Tables(5).Cell(DecisionCount + 1, 2).Range.Text = strClean
                
                strCellText = oTbl2.Cell(Row2, Col2 + 1).Range.Text
                strClean = Mid(strCellText, 1, Len(strCellText) - 2)
                MainDoc.Tables(5).Cell(DecisionCount + 1, 3).Range.Text = strClean
                
                strCellText = oTbl2.Cell(Row2, Col2 + 2).Range.Text
                strClean = Mid(strCellText, 1, Len(strCellText) - 2)
                MainDoc.Tables(5).Cell(DecisionCount + 1, 4).Range.Text = strClean
            End If
        Next
    Next

End Sub

Private Sub UpdateComplaint(inText1 As String, inText2 As String, MainDoc As Document, ComplaintDoc As Document, ComplaintCount As Integer)
   
Dim strClean As String
Dim oTbl2 As Table
Dim Row2 As Integer
Dim Col2 As Integer
Dim strCellText As String

Set oTbl2 = ComplaintDoc.Tables(1)
   
 For Row2 = 1 To oTbl2.Rows.Count
        For Col2 = 1 To oTbl2.Columns.Count
            strCellText = oTbl2.Cell(Row2, Col2).Range.Text
            strClean = Mid(strCellText, 1, Len(strCellText) - 2)
            If Trim(strClean) = inText1 Then
                MainDoc.Tables(2).Cell(ComplaintCount + 1, 2).Range.Text = strClean
                
                strCellText = oTbl2.Cell(Row2, Col2 + 1).Range.Text
                strClean = Mid(strCellText, 1, Len(strCellText) - 2)
                MainDoc.Tables(2).Cell(ComplaintCount + 1, 3).Range.Text = strClean
                
                strCellText = oTbl2.Cell(Row2, Col2 + 2).Range.Text
                strClean = Mid(strCellText, 1, Len(strCellText) - 2)
                MainDoc.Tables(2).Cell(ComplaintCount + 1, 4).Range.Text = strClean
            End If
        Next
    Next

End Sub
Reply With Quote
  #6  
Old 11-24-2019, 05:56 PM
Guessed's Avatar
Guessed Guessed is offline Auto fill based on previous entry Windows 10 Auto fill based on previous entry Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 1,389
Guessed is a jewel in the roughGuessed is a jewel in the roughGuessed is a jewel in the roughGuessed is a jewel in the rough
Default

Try declaring DecisionsDoc and ComplaintDoc as global variables (ie at the top of the module before any Subs). It will save you having to pass them between functions and possibly make them more robust as your code progresses.
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #7  
Old 11-25-2019, 06:49 AM
gmayor's Avatar
gmayor gmayor is online now Auto fill based on previous entry Windows 10 Auto fill based on previous entry Office 2016
Expert
 
Join Date: Aug 2014
Posts: 3,029
gmayor is just really nicegmayor is just really nicegmayor is just really nicegmayor is just really nicegmayor is just really nice
Default

There are several anomalies in your code which makes it difficult to follow exactly what it is that you are trying to achieve and therefore it is difficult to determine why the error is occurring ... especially without access to the documents themselves.

e.g. You have made reference to 'inText2' without actually using inText2 and you appear to have counters 'CompliantCount' and 'DecisionCount' which both appear to be duplicates of the variable 'Row'?

The MainDoc appears to have at least 5 tables (not 4 as previously mentioned) with no error handling to determine that the document is valid.
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
Reply

Tags
2010, auto populate

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Auto fill based on previous entry Form auto fill based on a different field value. stct Word 26 06-15-2019 04:08 PM
Auto fill drops down using VBA code based on selection AgilityJS Word VBA 5 11-03-2015 07:50 PM
How to remove auto type entry ep2002 Excel 19 11-06-2013 08:48 AM
Auto Entry Names etc Into Document simonyglog Word 2 07-08-2010 10:22 AM
Auto fill based on previous entry Sequentail Number Each Row Based On Another Column Entry KramerJ Excel 3 05-07-2009 11:35 PM


All times are GMT -7. The time now is 04:30 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2019 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft