Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, arrWords, i As Long, RGB As Long
arrWords = Array("keyword1 & keyword2", "keyword1", "keyword2", "keyword3")
Set Rng = Selection.Range
Rng.Paste
For i = 0 To UBound(arrWords)
  Select Case i
    Case 0: RGB = wdColorGray05
    Case 1: RGB = wdColorPaleBlue
    Case 2: RGB = wdColorLightOrange
    Case 3: RGB = wdColorPink
  End Select
  With Selection
    With .Find
      .ClearFormatting
      .Text = arrWords(i)
      .Replacement.Text = ""
      .Format = False
      .Forward = True
      .Wrap = wdFindStop
    End With
    Do While .Find.Execute
      If .InRange(Rng) = False Then Exit Do
      If .Shading.BackgroundPatternColor = wdColorAutomatic Then .Shading.BackgroundPatternColor = RGB
      .Collapse wdCollapseEnd
    Loop
  End With
  Rng.Select
Next
Application.ScreenUpdating = True
End Sub