Sub Highlighting()
Application.ScreenUpdating = False
Dim oChanges As Document, oDoc As Document
Dim oTable As Table, oRng As Range, i As Long
Dim rFindText As Range, sFname As String, HiLite As Long
HiLite = Options.DefaultHighlightColorIndex
Options.DefaultHighlightColorIndex = wdBrightGreen
sFname = "location of the file"
Set oDoc = ActiveDocument
Set oChanges = Documents.Open(FileName:=sFname, Visible:=False)
Set oTable = oChanges.Tables(1)
With oDoc.Range.Find
  .ClearFormatting
  .Format = True
  .Forward = True
  .Wrap = wdFindContinue
  .MatchWholeWord = True
  With .Replacement
    .ClearFormatting
    .Highlight = True
    .Text = "^&"
  End With
  For i = 1 To oTable.Rows.Count
    Set oRng = oTable.Rows(i).Cells(1).Range
    With oRng
      .End = .End - 1
      rFindText = .Text
    End With
    .Text = rFindText
    .Execute Replace:=wdReplaceAll
  Next
End With
Options.DefaultHighlightColorIndex = HiLite
oChanges.Close wdDoNotSaveChanges
Application.ScreenUpdating = True
End Sub