For Review

[Greg Maxey]

For the last four days I have been engrossed in trying to build a macro to
find and highlight text. It has little practical use other than provide a
learning opportunity. I want to thank Steve Hudson, Jezebel (would be nice
to know what variety of person you are), Jason Eacott, and Dennis A for
their gracious assistance. Working on this macro I was exposed to Dos,
boleans, arrays, Private, ubounds, learned a little about With Selection,
and several other tips. Here is the result for anyone interested. Go ahead
and tear it apart. I always welcome contructive criticism and free
schooling:

Option Explicit
Private fHlight As Boolean
Private mFword As String
Private pCcnt As Long 'sets the highlight color
Sub CountOccurrences()

Dim pCount As Long 'The occurence counter
Dim pHlight As VbMsgBoxResult 'option to highlight
Dim pCycleCols() As Variant 'array of highlight colors

'Clears find and replace dialog
Call ResetFRParameters

'Define the array of highlight colors
pCycleCols = Array(wdYellow, wdBrightGreen, wdTurquoise, wdTeal, wdPink,
wdRed)

'This next bit controls the highlight color to use
'and keeps it within the array range
On Error Resume Next
pCcnt = ActiveDocument.Variables("pCcnt").Value
On Error GoTo 0
If pCcnt < 0 Or pCcnt > UBound(pCycleCols) Then
pCcnt = 0

End If

'User input and options. Set/Reset counter to 0
mFword = InputBox("Type in the word or phrase that you want to find and
count.")
If mFword = "" Then
Exit Sub 'exist on no input or user cancel
End If
pCount = 0

pHlight = MsgBox("Do you want to highlight each occurrence?", vbYesNo,
"Highlight")

With Selection
.HomeKey wdStory
.Find.ClearFormatting
With .Find
.Text = mFword
.Wrap = wdFindStop
.MatchWholeWord = True
.MatchCase = False
.Forward = True
.MatchAllWordForms = False
Do While .Execute = True
If pHlight = vbYes Then
With Selection
.Range.HighlightColorIndex = pCycleCols(pCcnt)
.Collapse wdCollapseEnd
End With
End If
pCount = pCount + 1 'counts each occurrrence of the word
Loop
End With
End With
pCcnt = pCcnt + 1 'Up sequences color array
ActiveDocument.Variables("pCcnt").Value = pCcnt 'stores the value
'Display results
If pCount > 1 Then
MsgBox Chr$(34) & mFword & Chr$(34) & " was found " & _
pCount & " times."
ElseIf pCount = 1 Then
MsgBox Chr$(34) & mFword & Chr$(34) & " was found " & _
pCount & " time."
Else
MsgBox Chr$(34) & mFword & Chr$(34) & " was not found."
End If
ActiveDocument.Variables("mFword").Value = mFword

End Sub
Sub ClearHL()
Dim pQuerry As VbMsgBoxResult
Dim pClearAll As VbMsgBoxResult

Call TestForAnyHighlight 'Check if anything is highlighted
If fHlight Then

'Clears all highlighting
pClearAll = MsgBox("Do you want to remove highlighting throughout the
document?", _
vbYesNoCancel, "Restore All")
If pClearAll = vbYes Then
With Selection
.WholeStory
.Range.HighlightColorIndex = wdNoHighlight
.Collapse Direction:=wdCollapseStart
ActiveDocument.Variables("pCcnt").Value = 0
End With
Exit Sub
ElseIf pClearAll = vbCancel Then
Exit Sub
End If

'Gets last word highlighted
On Error Resume Next
mFword = ActiveDocument.Variables("mFword").Value
On Error GoTo 0

'Clears highlighting from last word
If Len(mFword) > 0 Then
If MsgBox("Do you want to restore normal formatting to " & Chr$(34) &
mFword & Chr$(34) & " the last word highlighted?", _
vbYesNo, "Restore Last") = vbYes Then
Call RemoveHighlight(mFword, pCcnt)
'Option to clear more if exists
Call TestForAnyHighlight
If fHlight Then
pQuerry = MsgBox("Do you want to restore normal formatting to another
individual phrase or character?", _
vbYesNo, "Continue")
End If
mFword = ""
End If
End If

If Len(mFword) = 0 Or pQuerry = vbYes Then
Do
mFword = InputBox$("Type in the word or phrase that you want restore
normal formatting.")
If LenB(mFword) = 0 Then
Exit Do
End If
Call RemoveHighlight(mFword, pCcnt)
Call TestForAnyHighlight
If fHlight Then
pQuerry = MsgBox("Do you want to restore normal formatting an
another individual phrase or character?", _
vbYesNoCancel, "Continue")
Else: Exit Do
End If
Loop Until pQuerry > 6
End If

Else: MsgBox "There is no higlighted text in the document"
End If

End Sub
Sub ResetFRParameters()

With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

End Sub
Sub RemoveHighlight(mFword As String, pCcnt As Long)
With Selection
.HomeKey wdStory
.Find.ClearFormatting
Do While .Find.Execute(FindText:=mFword, Wrap:=wdFindStop, _
MatchWholeWord:=True, Forward:=True) = True
Selection.Range.HighlightColorIndex = wdNoHighlight
Selection.Collapse wdCollapseEnd
Loop
End With
pCcnt = pCcnt - 1
ActiveDocument.Variables("pCcnt").Value = pCcnt
End Sub
Sub TestForAnyHighlight()
Call ResetFRParameters
fHlight = False
With Selection
.HomeKey wdStory
.Find.ClearFormatting
.Find.Highlight = True
If .Find.Execute Then
.Collapse wdCollapseEnd
fHlight = True
End If
End With
End Sub

 

[Helmut Weber]

Hi Greg,

Go ahead and tear it apart.

Well, no reason for it. As I have been experimenting
shortly with search and replace over all kinds of
storyranges like headers, footers, linked or not linked
to previous headers or footers, footnotes and all that
stuff, I'd suggest expanding your routines to really
process all of a doc, or at least, as much as
possible, and maybe, using the range object rather
than the selection object.
Just have a look at this example
and go ahead and tear it apart. ;-)
---
Sub Test3()
' Based on
'
http://word.mvps.org/FAQs/MacrosVBA/FindReplaceAllWithVBA.h
tm
' by Doug Robbins
Dim rDcm As Range
ResetFRParameters
For Each rDcm In ActiveDocument.StoryRanges
Call HighlightText(rDcm, "der", wdRed)
While Not (rDcm.NextStoryRange Is Nothing)
Set rDcm = rDcm.NextStoryRange
Call HighlightText(rDcm, "der", wdRed)
Wend
Next rDcm
ResetFRParameters
End Sub
' ---
Private Sub HighlightText(rLoc As Range, sWrd As String,
iClr As Integer)
Dim rDpl As Range
Set rDpl = rLoc.Duplicate
With rDpl.Find
.Text = sWrd
.Replacement.Text = sWrd
.Replacement.Highlight = True
While .Execute
rDpl.HighlightColorIndex = iClr
Wend
End With
End Sub
' ---
Sub ResetFRParameters()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
End Sub
' ---
Greetings from Bavaria, Germany
Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word 2002, Windows 2000

 

[Jonathan West]

Hi Greg,

I'll add my twopennyworth here...

For the last four days I have been engrossed in trying to build a macro to
find and highlight text. It has little practical use other than provide a
learning opportunity. I want to thank Steve Hudson, Jezebel (would be nice
to know what variety of person you are), Jason Eacott, and Dennis A for
their gracious assistance. Working on this macro I was exposed to Dos,
boleans, arrays, Private, ubounds, learned a little about With Selection,
and several other tips. Here is the result for anyone interested. Go ahead
and tear it apart. I always welcome contructive criticism and free
schooling:

Option Explicit
Private fHlight As Boolean
Private mFword As String
Private pCcnt As Long 'sets the highlight color
Sub CountOccurrences()

Dim pCount As Long 'The occurence counter
Dim pHlight As VbMsgBoxResult 'option to highlight
Dim pCycleCols() As Variant 'array of highlight colors

'Clears find and replace dialog
Call ResetFRParameters

Its a matter of preference, but the Call keyword is superfluous here. You
can just have the name of the routine like this

ResetFRParameters

If the routine takes paramaters, you would write it like this

ResetFRParameters param1, param2, param3

or using the Call keyword, like this

Call ResetFRParameters(param1, param2, param3)

'Define the array of highlight colors
pCycleCols = Array(wdYellow, wdBrightGreen, wdTurquoise, wdTeal, wdPink,
wdRed)

'This next bit controls the highlight color to use
'and keeps it within the array range
On Error Resume Next
pCcnt = ActiveDocument.Variables("pCcnt").Value
On Error GoTo 0
If pCcnt < 0 Or pCcnt > UBound(pCycleCols) Then
pCcnt = 0

End If

I would recommend you consistently indent your code for readability. Code
inside an If-Then, Do-Loop, With-End With or For-Next structure should be
indented, and nested code should be further indented. This makes it a whole
lot easier to see the structure of the code. You can set the amount that a
line is indented when you hit the tab key, by going to Tools, Options in the
VBA editor, and in the Editor tab of the dialog, setting the Tab width to
some value. I like to use 2.

In addition, I'd recommend that you be consistent as to the placement of
blank lines. Put one or more blank lines after some lines of code that
together perform some specific subtask. Thus, for the above bit of code, I
would format it as follows

'This next bit controls the highlight color to use
'and keeps it within the array range
On Error Resume Next
pCcnt = ActiveDocument.Variables("pCcnt").Value
On Error GoTo 0

If pCcnt < 0 Or pCcnt > UBound(pCycleCols) Then
pCcnt = 0
End If

Those last 3 lines *could* be combined into one as follows

If pCcnt < 0 Or pCcnt > UBound(pCycleCols) Then pCcnt = 0

But I would recommend against it. If you make a design decision never to use
one-line If-Then statements, you can always assume that every If statement
must be followed by indented code.

Excel MVP Stephen Bullen has produced a really useful utility called Smart
Indenter which will go through a routine or even a whole template and set
the indentation of the code according to principles like this. It is a free
download and you can find it here

http://www.bmsltd.ie/Indenter/Default.htm

Consistent indentation won't make your code run faster. But it will make it
easier to read and therefore to debug. Remember that code serves two
different purposes

1. It is a set of instructions to the computer to perform a task
2. It is a message to yourself (or to other programmers) as to the nature of
the task being performed.

Coding standards are mostly about item #2.

'User input and options. Set/Reset counter to 0
mFword = InputBox("Type in the word or phrase that you want to find and
count.")
If mFword = "" Then
Exit Sub 'exist on no input or user cancel
End If
pCount = 0

Again, consistent indenting would be useful

pHlight = MsgBox("Do you want to highlight each occurrence?", vbYesNo,
"Highlight")

With Selection
.HomeKey wdStory
.Find.ClearFormatting
With .Find
.Text = mFword
.Wrap = wdFindStop
.MatchWholeWord = True
.MatchCase = False
.Forward = True
.MatchAllWordForms = False
Do While .Execute = True
If pHlight = vbYes Then
With Selection
.Range.HighlightColorIndex = pCycleCols(pCcnt)
.Collapse wdCollapseEnd
End With
End If
pCount = pCount + 1 'counts each occurrrence of the word
Loop
End With
End With

This section of code would run a little faster if you use Range variables
instead of the Selection object. This is because moving the highlighted
selection round the screen and displaying it takes time. Even if you have
Application.ScreenUpdating set to False, there is some time lost because the
computer has to note what the changes are so that when screen display is
returned, it knows what to display. Therefore, you can rewrite this chunk of
code as follows

Dim myRange as Range
Set myRange = ActiveDocument.Range(0, 0)
With myRange
.Find.ClearFormatting
With .Find
.Text = mFword
.Wrap = wdFindStop
.MatchWholeWord = True
.MatchCase = False
.Forward = True
.MatchAllWordForms = False
Do While .Execute = True
If pHlight = vbYes Then
myRange.HighlightColorIndex = pCycleCols(pCcnt)
myRange.Collapse wdCollapseEnd
End If
pCount = pCount + 1 'counts each occurrrence of the word
Loop
End With
End With

pCcnt = pCcnt + 1 'Up sequences color array
ActiveDocument.Variables("pCcnt").Value = pCcnt 'stores the value

'Display results
If pCount > 1 Then
MsgBox Chr$(34) & mFword & Chr$(34) & " was found " & _
pCount & " times."
ElseIf pCount = 1 Then
MsgBox Chr$(34) & mFword & Chr$(34) & " was found " & _
pCount & " time."
Else
MsgBox Chr$(34) & mFword & Chr$(34) & " was not found."
End If
ActiveDocument.Variables("mFword").Value = mFword

End Sub

Indenting again. Normally, when I use the ine continuation character, I set
the subsequent lines with a double-indent (4 characters instead of two for
my layout)

Also, using the Chr$ function is a bit longwinded, you can use the fact that
including a pair of double-quotes inside a string literal results in one
double-quote being included in the string itself, like this

If pCount > 1 Then
MsgBox """" & mFword & """ was found " & _
pCount & " times."
ElseIf pCount = 1 Then
MsgBox """" & mFword & """ was found " & _
pCount & " time."
Else
MsgBox """" & mFword & """ was not found."
End If

 

[Greg Maxey]

Helmut,

Thanks for the reply and for being gentle. I was aware of VBA find replace
issue being limited to the story and the macro referenced by Doug Robbins.
The wheels were already turning on expanding mine to that level once I get
the kinks out of it. This range thing you mention I will have to have a
look at as well.

Thanks

 

[Greg Maxey]

Jonathan,

Thanks for the look. I will add your suggestions to the things to do and
try to remember them for futher use. You are the second person to suggest
the range issue. I hope I can figure it out without scattering what I have
already done. I will give it a go.