Sub ConditionalHighlight()
Application.ScreenUpdating = False
Dim vFindText As Variant, StrWrds As String, i As Long, Rng As Range
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 = False
      .MatchAllWordForms = False
      .MatchWholeWord = True
      .Wrap = wdFindStop
      .Text = vFindText(i)
      .Replacement.Text = ""
      .Execute
   End With
    Do While .Find.Found
      Set Rng = .Duplicate.Words.First
      With Rng
        If LCase(.Next.Words.First.Characters.First) = .Next.Words.First.Characters.First Then
          If .Sentences.First.Start = .Start Then
            Rng.Duplicate.HighlightColorIndex = wdBrightGreen
          Else
            With .Previous.Words.First
              If InStr(StrWrds, "," & Trim(.Text) & ",") > 0 Then
                Rng.Duplicate.HighlightColorIndex = wdBrightGreen
              ElseIf LCase(.Characters.First) = .Characters.First Then
                Rng.Duplicate.HighlightColorIndex = wdBrightGreen
              End If
            End With
          End If
        End If
      End With
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
Next i
Application.ScreenUpdating = True
End Sub