Sub ConditionalHighlight()
Application.ScreenUpdating = False
Dim vFindText As Variant, StrWrds As String, i As Long
vFindText = "Note,Notes"
vFindText = Split(vFindText, ",")
StrWrds = ",The,Each,"
For i = LBound(vFindText) To UBound(vFindText)
  With ActiveDocument.Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Format = False
      .MatchWildcards = True
      .Wrap = wdFindStop
      .Text = "<[! ]{1,}> " & vFindText(i) & ">"
      .Replacement.Text = ""
      .Execute
   End With
    Do While .Find.Found
      If InStr(StrWrds, "," & Trim(.Duplicate.Words.First.Text) & ",") > 0 Then
        .Duplicate.HighlightColorIndex = wdBrightGreen
      End If
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
Next i
Application.ScreenUpdating = True
End Sub