Find repeated word(s) in selected text

[tomasw]

Is there a way to have a macro examine selected text to find the duplicate words in the selection? If the code could be tuned to ignore words 3 letters and under, that would be amazing. Thank you for any help!

[macropod]

What constitutes 'duplicate words' in this context? For example, do they have to be immediately one after the other, or can there be other, intervening, words?

[gmaxey]

Lots of ways. Here is one using a dictionary class:

Option Explicit
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 9/10/2017
Dim oWord As Range
Dim strWord As String
Dim oDicWords As Object
Dim lngIndex As Long
  Set oDicWords = CreateObject("Scripting.Dictionary")
  oDicWords.CompareMode = vbBinaryCompare 'Test and test are unique words.
  'oDicWords.CompareMode = vbTextCompare 'Test and test are the same word.
  Set oDicWords = CreateObject("Scripting.Dictionary")
  For Each oWord In Selection.Range.Words
    strWord = Trim(oWord)
    If Len(strWord) > 3 Then
      If Not oDicWords.Exists(strWord) Then
        'Add and index word to dictionary.
        oDicWords.Add Key:=strWord, Item:=1
      Else
        'Word already exists.  Uptick counter.
        oDicWords.Item(strWord) = oDicWords.Item(strWord) + 1
      End If
    End If
  Next
  For lngIndex = 0 To oDicWords.Count - 1
    If oDicWords.Items()(lngIndex) > 1 Then
      'Report on words repeated 2 or more times.
      MsgBox oDicWords.Keys()(lngIndex) & " repeated " & oDicWords.Items()(lngIndex) & " time(s)"
    End If
  Next
lbl_Exit:
  Exit Sub
End Sub

[tomasw]

What constitutes 'duplicate words' in this context? For example, do they have to be immediately one after the other, or can there be other, intervening, words?

Hi Paul, I'm looking for the latter where the macro will highlight all words that have occurred more than once in the selection. Thanks!

[tomasw]

Lots of ways. Here is one using a dictionary class:

Thank you, Greg. I'm not that adept with VBA. How easily can this be converted to highlight those repeated words? Thanks!

[tomasw]

I looked at Greg's macro and in the course of testing, I found some three-letter words that, in retrospect, should be flagged as well.

Would it be possible to add a list of words the marco will skip if they are repeat, such as the words "and" and "the"?

[gmaxey]

Sub ScratchMacroII()
'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 9/10/2017
Dim oWord As Range
Dim strWord As String
Dim oDicWords As Object
Dim oDicExcludes As Object
Dim lngIndex As Long
  Set oDicWords = CreateObject("Scripting.Dictionary")
  Set oDicExcludes = CreateObject("Scripting.Dictionary")
  oDicWords.CompareMode = vbBinaryCompare 'Test and test are unique words.
  'oDicWords.CompareMode = vbTextCompare 'Test and test are the same word.
  With oDicExcludes
    .Add "and", "and"
    .Add "the", "the"
    .Add "The", "The"
  End With
  For Each oWord In Selection.Range.Words
    strWord = Trim(oWord)
    If Not oDicExcludes.Exists(strWord) Then
      If Not oDicWords.Exists(strWord) Then
        'Add and index word to dictionary.
        oDicWords.Add Key:=strWord, Item:=1
      Else
        'Word already exists.
        oWord.HighlightColorIndex = wdYellow
        'oDicWords.Item(strWord) = oDicWords.Item(strWord) + 1
      End If
    End If
  Next
'  For lngIndex = 0 To oDicWords.Count - 1
'    If oDicWords.Items()(lngIndex) > 1 Then
'      'Report on words repeated 2 or more times.
'      MsgBox oDicWords.Keys()(lngIndex) & " repeated " & oDicWords.Items()(lngIndex) & " time(s)"
'    End If
'  Next
lbl_Exit:
  Exit Sub
End Sub

[tomasw]

This works great! Thank you very much!