Mark Duplicated Words

Monday, August 8, 2011

If you'd like an easy way to improve your writing style, try this lengthy-looking macro and function.

It examines each sentence in your document looking for repeated words.

A string "strDismiss" is set up to avoid reporting words which I think are allowed to be repeated.

Repeated words are flagged with Microsoft Word's character style "Strong", so you may want to modify that in your Normal.dot to be bright pink, 16 point, or whatever.

Don't forget that you can clear all local formatting with Ctrl-A followed by Ctrl-Space.

Public strDismiss As String
Sub MarkDuplicatedWords()
    strDismiss = vbTab & "for" & vbTab & "and" & vbTab & "that" & vbTab & "," & vbTab & "." & vbTab & "to" & vbTab
    strDismiss = strDismiss & "http" & vbTab & "://" & vbTab & "www" & vbTab & "com" & vbTab & "/" & vbTab & "the" & vbTab
    strDismiss = strDismiss & "a" & vbTab & "of" & vbTab & "www" & vbTab & "com" & vbTab & "/" & vbTab & "the" & vbTab
    strDismiss = strDismiss & """" & vbTab & "of" & vbTab & "www" & vbTab & "com" & vbTab & "/" & vbTab & "the" & vbTab
    Dim prg As Paragraph
    For Each prg In ActiveDocument.Paragraphs
        Dim snt As Range
        For Each snt In prg.Range.Sentences
            If lngCountDuplicatedWords(snt, strDismiss, ActiveDocument.Styles("Strong")) > 0 Then
            Else
            End If
        Next snt
    Next prg
End Sub
Function lngCountDuplicatedWords(rng As Range, strDismiss As String, sty As Style)
    Dim lngResult As Long
    Dim strSentence As String
    strSentence = vbTab
    Dim wd As Range
    For Each wd In rng.Words
        Dim strWord As String
        strWord = Trim(wd.Text)
        If InStr(1, strDismiss, vbTab & strWord & vbTab) > 0 Then ' we can ignore this word
        Else
            If InStr(1, strSentence, vbTab & strWord & vbTab) > 0 Then
                lngResult = lngResult + 1
                wd.Style = sty
            Else
                strSentence = strSentence & strWord & vbTab
            End If
        End If
    Next wd
    lngCountDuplicatedWords = lngResult
End Function

Search