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