Sub DupWordMarks()
  Dim aWord As String, iCounter As Long, iWords As Long, iLen As Long, iTotalWords As Long
  Dim aRng As Range, iEnd As Long, i As Long
    
  iLen = 20   'the size of the range searched forward
  iTotalWords = ActiveDocument.Words.Count
  
  For iCounter = 1 To iTotalWords - 1
    Select Case Trim(ActiveDocument.Words(iCounter))
      Case "you", "a", "the", "can", "for", ".", "to", "and", ",", ";"
        'do nothing
      Case Else
        If iCounter + iLen < iTotalWords Then
          iEnd = iCounter + iLen
        Else
          iEnd = iTotalWords
        End If
        Set aRng = ActiveDocument.Range(ActiveDocument.Words(iCounter).End, ActiveDocument.Words(iEnd).End)
        For i = 1 To aRng.Words.Count
          If LCase(Trim(ActiveDocument.Words(iCounter))) = LCase(Trim(aRng.Words(i))) Then
            aRng.Words(i).HighlightColorIndex = wdPink
            Exit For
          End If
        Next i
    End Select
    'If iCounter = 500 Then Exit Sub   'enable an artificial restraint to stop the code when testing
  Next iCounter
End Sub