Auto fill based on previous entry

geojf3 · #1 11-22-2019, 06:09 AM

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.

geojf3 · #2 11-22-2019, 09:09 AM

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

gmayor · #3 11-23-2019, 01:57 AM

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

geojf3 · #4 11-23-2019, 06:51 AM

Thats works great...thank you!

geojf3 · #5 11-24-2019, 07:44 AM

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

Guessed · #6 11-24-2019, 05:56 PM

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.

gmayor · #7 11-25-2019, 06:49 AM

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.

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
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
Sequentail Number Each Row Based On Another Column Entry	KramerJ	Excel	3	05-07-2009 11:35 PM