Sub BulkHighlighter()
Application.ScreenUpdating = False
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String
Dim iDataRow As Long, xlList As String, h As Long, i As Long
StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\WordList.xlsx"
If Dir(StrWkBkNm) = "" Then
  MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
  Exit Sub
End If
On Error Resume Next
'Start Excel
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
  MsgBox "Can't start Excel.", vbExclamation
  Exit Sub
End If
On Error GoTo 0
With xlApp
  'Hide our Excel session
  .Visible = False
  ' The file is available, so open it.
  Set xlWkBk = .Workbooks.Open(StrWkBkNm, False, True)
  If xlWkBk Is Nothing Then
    MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
    .Quit: Set xlApp = Nothing: Exit Sub
  End If
  ' Process the workbook.
  With xlWkBk
    With .Worksheets("Sheet1")
      ' Find the last-used row in column A.
      iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
      ' Capture the F/R data.
      For i = 1 To iDataRow
        ' Skip over empty fields to preserve the underlying cell contents.
        If Trim(.Range("A" & i)) <> vbNullString Then
          xlList = xlList & "|" & Trim(.Range("A" & i))
        End If
      Next
    End With
  .Close False
  End With
  .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Exit if there are no data
If xlList = "" Then Exit Sub
h = Options.DefaultHighlightColorIndex
Options.DefaultHighlightColorIndex = wdBrightGreen
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .MatchWholeWord = True
  .MatchCase = True
  .Wrap = wdFindContinue
  .Replacement.Text = "^&"
  .Replacement.Highlight = True
  'Process each word from the List
  For i = 1 To UBound(Split(xlList, "|"))
    .Text = Split(xlList, "|")(i)
    .Execute Replace:=wdReplaceAll
  Next
End With
Options.DefaultHighlightColorIndex = h
Application.ScreenUpdating = True
End Sub