To use, open Word, go to Tools - Macro - Macros ... and click on the Create button. This should open up the macro editor. Simply copy the above code, paste it in and click the Save button and then close the Macro Editor. You should be done When you want to run it, you go back to Tools - Macro - Macros ... select the FAF_WordHighlighter macro and click the Run button - it will process the currently open document.
code:
Sub FAF_WordHighlighter()
'
' WordHighlighter Macro
' Highlight specific types of words in current document
On Error GoTo Err_HighlightWords Dim adverbExList
Dim passiveList
Dim overusedList
Dim clicheList
Dim adverbColor As WdColorIndex
Dim passiveColor As WdColorIndex
Dim overusedColor As WdColorIndex
Dim clicheColor As WdColorIndex
' *** Modify the following section to configure ***
adverbExList = Array("only", "oily", "family", "homily", _
"Billy", "Sally", "multiply", "imply", "gangly", _
"apply", "bully", "belly", "silly", "jelly", "holy", _
"lovely", "holly", "fly", "July", "rely", "reply", _
"Lilly", "sully", "gully" _
)
adverbColor = wdYellow
passiveList = Array("is", "isn't", "am", "are", "aren't", "was", _
"wasn't", "were", "will", "would", "won't", "has", _
"had", "have", "be", "been", "do", "don't", _
"did", "didn't", "does", "doesn't", "by", "being" _
)
passiveColor = wdPink
overusedList = Array("seem", "seems", "exist", "exists", "appears", _
"make", "makes", "show", "shows", "occur", "occurs", "get", _
"got", "went", "put", "some", "many", "most", "that", "very", _
"extremely", "totally", "completely", "wholly", "utterly", _
"quite", "rather", "slightly", "fairly", "somewhat", _
"suddenly", "all of a sudden" _
)
overusedColor = wdTurquoise
clicheList = Array("kind of", "sort of", "the reason for", _
"past history", "this is why", "end result", _
"it is possible that", "the possibility exists", _
"for all intents and purposes", "there is a chance that", _
"is able to", "has the opportunity to", "past memories", _
"future plans", "sudden crisis", "terrible tragedy", _
"as a matter of fact", "quite frankly", "all the time", _
"white as a sheet", "as soon as possible", "at the very least", _
"down in the dumps", "in the nick of time", "hat in hand", _
"keep your mouth shut", "made a run for it" _
)
clicheColor = wdBrightGreen
' *** do not modify code beyond this if you don't know what you're doing ***
'variables
Dim word
Dim rng As Range
Dim excluded As Boolean
Dim story As WdStoryType
Dim oldTrack
Dim oldHighlight
' Save current settings
oldTrack = ActiveDocument.TrackRevisions
oldHighlight = Options.DefaultHighlightColorIndex
ActiveDocument.TrackRevisions = False
' Iterate through each document section
For Each rng In ActiveDocument.StoryRanges
' Work only with the main body, footnotes and endnotes
story = rng.StoryType
If story <> wdMainTextStory And story <> wdFootnotesStory And story <> wdEndnotesStory Then
GoTo NextRange
End If
' Do the adverb highlighting
rng.Find.ClearFormatting
rng.Find.Replacement.ClearFormatting
With rng.Find
.Text = "<[! ]@(ly)>"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Do While rng.Find.Execute(Replace:=wdNone) = True
If rng.Text = "" Then
Exit Do
End If
excluded = False
For Each word In adverbExList
If rng.Text = word Then
excluded = True
Exit For
End If
Next
If Not excluded Then
' Highlight current selection
rng.HighlightColorIndex = adverbColor
End If
Loop
' Obtain range again
Options.DefaultHighlightColorIndex = passiveColor
rng.WholeStory
' Set rng = ActiveDocument.StoryRanges.Item(story)
' Do passive word highlighting
rng.Find.ClearFormatting
rng.Find.Replacement.ClearFormatting
rng.Find.Forward = True
rng.Find.Wrap = wdFindContinue
rng.Find.Replacement.Highlight = True
rng.Find.Format = True
rng.Find.MatchCase = False
rng.Find.MatchWholeWord = True
rng.Find.MatchWildcards = False
rng.Find.MatchSoundsLike = False
rng.Find.MatchAllWordForms = False
For Each word In passiveList
rng.Find.Text = word
rng.Find.Execute Replace:=wdReplaceAll
Next
' Do overused word highlighting
Options.DefaultHighlightColorIndex = overusedColor
rng.WholeStory
For Each word In overusedList
rng.Find.Text = word
rng.Find.Execute Replace:=wdReplaceAll
Next
' Do misused word/cliche highlighting
Options.DefaultHighlightColorIndex = clicheColor
rng.WholeStory
For Each word In clicheList
rng.Find.Text = word
rng.Find.Execute Replace:=wdReplaceAll
Next
NextRange:
Next
' Restore saved settings
ActiveDocument.TrackRevisions = oldTrack
Options.DefaultHighlightColorIndex = oldHighlight
MsgBox "Word highlighting complete!"
Exit Sub
Err_HighlightWords:
MsgBox Err.Description
End Sub