Sub HiLightList()
Application.ScreenUpdating = False
Dim StrFnd As String, Rng As Range, i As Long
StrFnd = "cat,pig,dog,whatever"
For i = 0 To UBound(Split(StrFnd, ","))
  Set Rng = ActiveDocument.Range
  With Rng.Find
    .ClearFormatting
    .Text = Split(StrFnd, ",")(i)
    .Replacement.ClearFormatting
    .Replacement.Highlight = True
    .Replacement.Text = "^&"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = True
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = True
    .Execute Replace:=wdReplaceAll
  End With
Next
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

Sub DeletePages()
Application.ScreenUpdating = False
Dim p As Long, Rng As Range
With ActiveDocument
  For p = .ComputeStatistics(wdStatisticPages) To 1 Step -1
    Set Rng = .Range.GoTo(What:=wdGoToPage, Count:=p).GoTo(What:=wdGoToBookmark, Name:="\Page")
    If Rng.HighlightColorIndex = wdNoHighlight Then Rng.Delete
  Next
End With
Application.ScreenUpdating = True
End Sub

Sub DeletePages()
Dim p As Long
With ActiveDocument
  For p = .ComputeStatistics(wdStatisticPages) To 1 Step -1
    With .ActiveWindow.Panes(1).Pages(p).Rectangles(1).Range
      If .HighlightColorIndex = wdNoHighlight Then .Delete
    End With
  Next
End With
End Sub