Sub ACRO_table3()

Dim oTbl As Table, qTbl As Table
Dim oRng As Range
Dim strAcr As String, strFnd As String, strDef As String
Dim i As Long, j As Long

strAcr = ","

Set oTbl = ActiveDocument.Tables(1) 'the 2-column table containing the acronym and definition
Set qTbl = ActiveDocument.Tables(2) 'the table containing the acronyms to list with their definition
Set oRng = ActiveDocument.Range.Characters.Last

For i = 1 To oTbl.Rows.Count

    With oTbl.Cell(i, 1).Range
    
    strFnd = Left(.Text, Len(.Text) - 2)
    strAcr = strAcr & strFnd & ","
    
    End With

Next i

With qTbl.Range
    With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Format = False
    .Forward = True
    .Text = "<[A-Z]{3,}>"
    .MatchWildcards = True
    .Execute
    End With

    Do While .Find.Found
    
    strFnd = .Text
    
    If .Characters.Last.Information(wdWithInTable) = True Then

        If InStr(strAcr, "," & strFnd & ",") <> 0 Then
        strAcr = strAcr & strFnd & ","
        strDef = Trim(InputBox("KNOWN Term Found: " & strFnd & vbCr & _
          "Add to definitions?" & vbCr & _
          "If yes, type the definition."))
          
            If strDef <> vbNullString Then
                With oRng
                .Text = strFnd & " = " & strDef & "; "
                .Collapse wdCollapseEnd
                .Style = "Legend"
                .InsertParagraph
                End With
            End If

        ElseIf InStr(strAcr, "," & strFnd & ",") = 0 Then
        strAcr = strAcr & strFnd & ","
        strDef = Trim(InputBox("NEW Term Found: " & strFnd & vbCr & _
          "Add to definitions?" & vbCr & _
          "If yes, type the definition."))
          
            If strDef <> vbNullString Then
                With oRng
                .Text = strFnd & " = " & strDef & ";" & vbNewLine
                .Collapse wdCollapseEnd
                .Style = "Legend"
                .HighlightColorIndex = wdYellow
                .InsertParagraph
                End With
            End If
                   
        Else
        End If
    
    Else: Exit Do
        
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
    
    Loop

End With

End Sub