Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, arrWords, i As Long
arrWords = Array("keyword1", "keyword2", "keyword3")
Options.DefaultHighlightColorIndex = wdYellow
Set Rng = Selection.Range
With Rng
  .Paste
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindStop
    .Replacement.Text = "^&"
    .Replacement.Highlight = True
    For i = 0 To UBound(arrWords)
      .Text = arrWords(i)
      .Execute Replace:=wdReplaceAll
    Next
  End With
End With
Application.ScreenUpdating = True
End Sub