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 = False
      .MatchAllWordForms = False
      .MatchWholeWord = True
      .Wrap = wdFindStop
      .Text = vFindText(i)
      .Replacement.Text = ""
      .Execute
   End With
    Do While .Find.Found
      With .Duplicate.Words.First
        If LCase(.Next.Words.First.Characters.First) = .Next.Words.First.Characters.First Then
          .MoveEnd wdWord, 1
          If .Characters.First.Previous <> vbCr Then
            If InStr(StrWrds, "," & Trim(.Previous.Words.First.Text) & ",") > 0 Then
              .MoveStart wdWord, -1
              .Duplicate.HighlightColorIndex = wdBrightGreen
            ElseIf LCase(.Previous.Words.First.Characters.First) = .Previous.Words.First.Characters.First Then
              If .Previous.Words.First.Characters.First.Previous = vbCr Then
                .MoveStart wdWord, -1
                .Duplicate.HighlightColorIndex = wdBrightGreen
              End If
            End If
          End If
        End If
      End With
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
Next i
Application.ScreenUpdating = True
End Sub