Sub Demo()
Application.ScreenUpdating = False
Dim FRDoc As Document, strFnd As String, strRep As String, i As Long
Set FRDoc = Documents.Open("Drive:\FilePath\FindTableData.doc", _
  ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)
For i = 1 To FRDoc.Tables(1).Rows.Count
  strFnd = Split(FRDoc.Tables(1).Cell(i, 1).Range.Text, vbCr)(0)
  strRep = Split(FRDoc.Tables(1).Cell(i, 2).Range.Text, vbCr)(0)
  With ActiveDocument.Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Format = False
      .MatchCase = True
      .MatchWholeWord = True
      .MatchWildcards = False
      .Wrap = wdFindStop
      .Text = strFnd
      .Execute
    End With
    Do While .Find.Found
      .HighlightColorIndex = wdBrightGreen
      .Comments.Add .Duplicate, strRep
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
Next
Application.ScreenUpdating = True
End Sub