How Can I Get a Count of Replacements Made by VBA

D

DonRange

A find and replace done manually from the dialog box in Word 2003 reports the
number of replacements made upon completion of the operation with a message
such as "Word has completed its search of the document and has made 5
replacements." If I record this operation with the Macro Recorder, the VBA
code listed below is recorded. When I execute this code from the VBA editor
the replacements are correctly made, but no notification box with the count
of how many were made is generated. What can I add to the VBA code to have
it return the count?

Sub Macro6()
'
' Macro6 Macro
' Macro recorded 11/8/2008 by Donald Range
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "grace"
.Replacement.Text = "gracie"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
 
G

Greg Maxey

Don,

While Jay's suggestions works, in some cases it might be simplier to just
replace the found text one at a time and count the replacements. I'm sure
it slows things down a microsecond or two but works well:

Sub ScratchMacro()
Dim oRng As Word.Range
Dim i As Long
Dim pText As String
Dim pRText As String
pText = InputBox("Enter text to find", "Find")
pRText = InputBox("Enter replacement text", "Replace With")
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = pText
.Replacement.Text = pRText
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
While .Execute(Replace:=wdReplaceOne)
oRng.Collapse wdCollapseEnd
i = i + 1
Wend
End With
Select Case i
Case 0
MsgBox pText & " not found."
Case 1
MsgBox "Found " & pText & " " & i & " time."
Case Is > 1
MsgBox "Found " & pText & " " & i & " times."
End Select
End Sub

A find and replace done manually from the dialog box in Word 2003
reports the number of replacements made upon completion of the
operation with a message such as "Word has completed its search of
the document and has made 5 replacements." If I record this
operation with the Macro Recorder, the VBA code listed below is
recorded. When I execute this code from the VBA editor the
replacements are correctly made, but no notification box with the
count of how many were made is generated. What can I add to the VBA
code to have it return the count?

Sub Macro6()
'
' Macro6 Macro
' Macro recorded 11/8/2008 by Donald Range
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "grace"
.Replacement.Text = "gracie"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

--
Greg Maxey - Word MVP

My web site http://gregmaxey.mvps.org


Nov 4, 2008. Remember it well. You just might
spend your sunset years telling your children and
your children's children what it was once like in
the United States where men were free.
 
D

DonRange

Thanks Jay, and also to Greg for your replies. I'm glad to know that it's a
VBA limitation (no need to continue searching for that elusive variable) and
that both workarounds are available. I had checked the FAQ, but obviously
not carefully enough.

Don
 
G

Greg Maxey

Jay,

Dave's method didn't work for me if the strings were equal. The final
result replacing Big with Dog was
each instance of Dog still had the flag #Dog.

I changed selection.find to oRng.find and set the range again before the
second replacement and it works now:

Sub Test()
MsgBox "Number of replacements: " & CountNoOfReplaces _
(StrFind:="Big", StrReplace:="Dog"), vbInformation
End Sub

Function CountNoOfReplaces(StrFind As String, StrReplace As String)
Dim NumCharsBefore As Long, NumCharsAfter As Long, LengthsAreEqual As
Boolean, oRng As Word.Range
Set oRng = ActiveDocument.Range
Application.ScreenUpdating = False
'Check whether the length of the Find and Replace strings are the same; _
if they are, prefix the replace string with a hash (#)
If Len(StrFind) = Len(StrReplace) Then
LengthsAreEqual = True
StrReplace = "#" & StrReplace
End If
'Get the number of chars in the doc BEFORE doing Find & Replace
NumCharsBefore = ActiveDocument.Characters.Count
'Do the Find and Replace
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = StrFind
.Replacement.Text = StrReplace
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
'Get the number of chars AFTER doing Find & Replace
NumCharsAfter = ActiveDocument.Characters.Count
'Calculate of the number of replacements,
'and put the result into the function name variable
CountNoOfReplaces = (NumCharsBefore - NumCharsAfter) / _
(Len(StrFind) - Len(StrReplace))
'If the lengths of the find & replace strings were equal at the start, _
do another replace to strip out the #
If LengthsAreEqual Then
'Redefine oRng
Set oRng = ActiveDocument.Range
StrFind = StrReplace
'Strip off the hash
StrReplace = Mid$(StrReplace, 2)
With oRng.Find
.Text = StrFind
.Replacement.Text = StrReplace
.Execute Replace:=wdReplaceAll
End With
End If
Application.ScreenUpdating = True
'Free up memory
ActiveDocument.UndoClear
End Function







Jay said:

--
Greg Maxey - Word MVP

My web site http://gregmaxey.mvps.org


Nov 4, 2008. Remember it well. You just might
spend your sunset years telling your children and
your children's children what it was once like in
the United States where men were free.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top