Sub ScratchMacro()
'A basic Word Macro coded by Gregory K. Maxey
Dim oCol As New Collection
Dim clrfind
Dim oRng As Range, oRngSub As Range, oRngFF As Range
Dim bOne As Boolean
  Application.ScreenUpdating = False
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .ClearFormatting
    .Highlight = True
    .Wrap = wdFindStop
    While .Execute
      Set oRngFF = oRng.Duplicate
      bOne = True
      On Error Resume Next
      oCol.Add oRng.Text, oRng.Text
      If Err.Number = 0 Then
        clrfind = oRng.HighlightColorIndex
        Set oRngSub = ActiveDocument.Range
        oRngSub.Start = oRng.End
        With oRngSub.Find
           .Text = oRng
           .MatchCase = True
           .MatchWholeWord = True
           While .Execute
             bOne = False
             oRngSub.HighlightColorIndex = clrfind
           Wend
         End With
         oRng.Collapse wdCollapseEnd
         If bOne Then
           oRngFF.HighlightColorIndex = wdNoHighlight
           oRngFF.HighlightColorIndex = wdRed
         End If
      Else
        Err.Clear
      End If
    Wend
  End With
  Application.ScreenUpdating = True
  Set oRng = Nothing: Set oRngSub = Nothing
lbl_Exit:
  Exit Sub
End Sub