Microsoft Office Forums - View Single Post - [Solved] Highlight keywords in the pasted text

macropod · 05-27-2020, 05:01 AM

Since you can't us a BackgroundPatternColor property as a Find parameter, you'll need to revert to a nested loop. Try:

Code:

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

Insert your preferred RGB colour values in place of the named constants in the Select Case statement.