Tech Eval

[Greg]

Regulars here will acknowledge that I am a novice. Yesterday an OP asked how
to automatically format repetive words in a different font style. I don't
know of anything other than the spell checker repeated word marker that would
automatically flag repeated words as the user typed, but I started playing
with a macro that would evaluate a bit of completed text for repetitive words
and mark as appropriate. My cobbled attempt follows. Basically the macro
simply looks at a word, compares it to the last word, and changes the font
attributes if the two match. Problems encountered was with the first word
since there isn't a previous word which I worked around with the error
handler, second problem was with empty paragraphs picking up the formating
which I got around by skipping them.

I would appreciate any comments on this method or pointers to a more
efficient method. Thanks

Sub Test()
Dim i As Long
Dim aWord As Range
i = 0
For Each aWord In ActiveDocument.Words
i = i + 1
On Error GoTo Skip
If aWord = Chr$(13) Then GoTo Skip
If aWord = ActiveDocument.Words(i - 1) Then
With aWord.Font
.Bold = True
.Color = wdColorBlue
End With
End If
Skip:
Next aWord

End Sub

 

[Greg]

I have found two flaws :-( and fixed one

The original codes would not flagged repeated words at the end of a sentence
or followed by a any puncuation. I believe I have fixed this using RTrim

If RTrim(aWord) = RTrim(ActiveDocument.Words(i - 1)) Then ...

The other problem is repeated words at the beginning of the sentence. For
example "Now now is the time for all good men ..." the second now is not
flagged. However "Now Now is the time ..." the second Now is flagged.

I can't figure out to ignore case :-(

 

[Jay Freedman]

Hi Greg,

Your approach is good, but I dislike using error handlers and GoTo
statements when they can be avoided.

The problem of the first word not having a previous word can be solved by
comparing the range aWord to the range ActiveDocument.Words.First and
skipping the processing if they match. You can skip empty paragraphs without
a GoTo by inverting the If statement:
If (aWord.Text <> vbCr) Then
' do stuff

There's another gotcha that you haven't considered: If the "previous" word
is followed by a space but the repetition of it is followed by punctuation,
you won't get a match because ActiveDocument.Words(i - 1) includes the
space. I solved that with a call to the Trim function.

Here's my version:

Sub Test2()
Dim aWord As Range
Dim strWord As String, strPrev As String
For Each aWord In ActiveDocument.Words
If (aWord.Text <> vbCr) Then
strWord = Trim(aWord.Text)
If (Not aWord.InRange(ActiveDocument.Words.First)) Then
If strWord = strPrev Then
With aWord.Font
.Bold = True
.Color = wdColorBlue
End With
End If ' words equal
End If ' not first word
strPrev = strWord
End If ' not vbCr
Next aWord
End Sub

 

[Greg]

Jay,

Your reply and my first follow up must have crossed. I had noted the issue
with the trailing character and modified my original code to allow for that.
I like your approach much better. Both our codes now share a common flaw.
That being a FirstCap word starting a sentence and a repetitive second word.
Any ideas?

Thanks

 

[Jay Freedman]

Hi Greg,

Yes, I saw your update just after I posted my reply. Bad timing...

To make string comparisons case-insensitive, you compare either all-caps or
all-lower-case versions of the strings -- either

If UCase(strWord) = UCase(strPrev) Then

or

If LCase(strWord) = LCase(strPrev) Then

Another way to accomplish it is with the StrComp function, specifying Text
Compare which is case-insensitive:

If StrComp(strWord, strPrev, vbTextCompare) = 0 Then

 

[Greg]

Jay,

Thanks for the nudges. All good reasons why folks around here "wouldn't"
call you a novice