Sub BulkHiliter()
Application.ScreenUpdating = False
Dim FRDoc As Document, FRList, i As Long
 'Load the strings from the reference doc into a text string to be used as an array.
Set FRDoc = Documents.Open("Drive:\FilePath\FindReplaceList.doc", ReadOnly:=True, Addtorecentfiles:=False, Visible:=False)
FRList = FRDoc.Range.Text: FRDoc.Close False: Set FRDoc = Nothing
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .MatchWholeWord = True
  .MatchCase = True
  .Replacement.Text = "^&"
  .Replacement.Highlight = True
  'Process each word from the List
  For i = 0 To UBound(Split(FRList, vbCr)) - 1
    .Text = Split(FRList, vbCr)(i)
    .Execute Replace:=wdReplaceAll
  Next
End With
Application.ScreenUpdating = True
End Sub