Number of Finds and Replaces

[Ricardo Muiz]

I know I've seen this posted before but...

I'm trying to find a quick way to count the number of word's occurences
within a document. The Find method can be slow. What I really want is the
information from the Find and Replace dialog message through the user
interface (something like "This or that has been replaced 993 times"). How
can get hold of the text from that message?

 

[Jay Freedman]

See http://word.mvps.org/FAQs/MacrosVBA/NoTimesTextInDoc.htm -- I
think that's what you're referring to as "the Find method".

Another scheme is to (a) get the value of ActiveDocument.Words.Count,
(b) do a ReplaceAll to replace the word being counted with "" (that
is, delete all occurrences), (c) get the new value of
ActiveDocument.Words.Count and subtract it from the original count to
get the number of replacements, and (d) run Undo to put the words
back.

A third scheme is to assign ActiveDocument.Range.Text to a string
variable, and iterate the InStr method over it (using the optional
first argument to move the starting position each time).

I'll leave it to you to find out which is fastest in your application.

--
Regards,
Jay Freedman
Microsoft Word MVP
Email cannot be acknowledged; please post all follow-ups to the
newsgroup so all may benefit.

 

[Greg Maxey]

Jay,

Is something like this what you had in mind by method 3?

Sub Test()
Dim oString As String
oString = ActiveDocument.Range.Text
Dim i As Long
Dim j As Long
i = 1
While InStr(i, oString, "now") <> 0
i = InStr(i, oString, "now") + 1
j = j + 1
Wend
MsgBox j
End Sub

 

[Helmut Weber]

Hi Ricardo,

http://word.mvps.org/FAQs/MacrosVBA/GetNoOfReplacements.htm

If you want to use the dialog,
how about this rather unusual solution,
as there seems always to be an error in
editreplace, because the last attempt of replacing fails,
and the message displayed after
the replacement is the error description.

One thing I couldn't manage,
was to put the find-string in the message, like:

"quick" was found x times.

Maybe somebody else will find a way. <<<

Sub test()
Dim ss As String ' short string, the number of replacements
Dim sl As String ' long string, the error message
Dim l As Long ' just a loop variable
Dim oDlg As Dialog

ActiveDocument.Range(0, 0).Select
Selection.ExtendMode = False
ResetSearch

Set oDlg = Dialogs(wdDialogEditReplace)
On Error Resume Next
oDlg.Display
sl = Err.Description
' in localized versions you don't know
' where the number of replacements occurs in the text
For l = 1 To Len(sl)
If IsNumeric(Mid(sl, l, 1)) Then
ss = ss & Mid(sl, l, 1)
End If
Next
MsgBox " Found: " & ss & " times"
ResetSearch
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Helmut Weber]

Public Sub ResetSearch()
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
.Execute
End With
End Sub

 

[Jezebel]

Simpler would be a version of the second method: use Replace to remove all
instances of the string, then divide then change in length by the length of
the word.

pLenBefore = len(oString)
oString = Replace(oString, SearchWord, "")
pLenAfter = len(oString)
pCount = (pLenBefore - pLenAfter) / len(SearchWord)

In both cases (this method and your original) you'd need to defend against
the possibility of the search word being a substring of another word.

 

[Ricardo Muiz]

I like Helmut's approach - almost.

Unconventional is one thing but, first, it seems to rely on a bug. Not that
Microsoft would ever fix it. Second, the user has to see dialogs popping up
each time (apparently even if you hide the application). This can be fixed
by using the .Execute method. However, that does not return an error
(Err.Number = 0) so there is no string to parse and I'm back to the original
problem.

For completeness, here's some code to make it run automatically. Helmut did
the clever work, I added the SendKeys.

Sub test()
Dim ss As String ' short string, the number of replacements
Dim sl As String ' long string, the error message
Dim l As Long ' just a loop variable
Dim oDlg As Dialog

ActiveDocument.Range(0, 0).Select
Selection.ExtendMode = False
'ResetSearch

Set oDlg = Dialogs(wdDialogEditReplace)
On Error Resume Next
oDlg.Find = "a"
oDlg.Replace = "X"
oDlg.ReplaceAll = True
SendKeys "%a" 'This also relys on this dialog not changing in a
subsequent release.
SendKeys "{tab}"
SendKeys "{tab}"
SendKeys "{tab}"
SendKeys "{enter}"
oDlg.Display
'oDlg.Execute
sl = Err.Description
' in localized versions you don't know
' where the number of replacements occurs in the text
For l = 1 To Len(sl)
If IsNumeric(Mid(sl, l, 1)) Then
ss = ss & Mid(sl, l, 1)
End If
Next
ActiveDocument.Undo
'ResetSearch
MsgBox " Found: " & ss & " times"
End Su

 

[Greg Maxey]

Hmm.... by adding *:

oDlg.ReplaceAll = True
SendKeys "%m" '****
SendKeys "%y" '****
SendKeys "%a" 'Th

One iteration will give whole words only and the next iteration gives a
instances. It is late and I haven't figured out if it is possible to do
whole word only consistently.

 

[Greg Maxey]

I had failed to reset find and replace parameters. With that and then
additional sendkeys, you can restrict the count to whole words only:

Sub test()
Dim ss As String ' short string, the number of replacements
Dim sl As String ' long string, the error message
Dim l As Long ' just a loop variable
Dim oDlg As Dialog
ResetFRParameters
ActiveDocument.Range(0, 0).Select
Selection.ExtendMode = False
Set oDlg = Dialogs(wdDialogEditReplace)
On Error Resume Next
oDlg.Find = "a"
oDlg.Replace = "a"
oDlg.ReplaceAll = True
SendKeys "%m"
SendKeys "%y"
SendKeys "%a"
SendKeys "{tab}"
SendKeys "{tab}"
SendKeys "{tab}"
SendKeys "{enter}"
oDlg.Display
sl = Err.Description
For l = 1 To Len(sl)
If IsNumeric(Mid(sl, l, 1)) Then
ss = ss & Mid(sl, l, 1)
End If
Next
ResetFRParameters
MsgBox " Found: " & ss & " times"
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
.Execute
End With
End Sub

 

[Greg Maxey]

One thing I couldn't manage,
was to put the find-string in the message, like:


Helmut, using Ricado's adaption we can set a string value equal to
oDlg.Find and then:


Sub test()
Dim ss As String ' short string, the number of replacements
Dim sl As String ' long string, the error message
Dim l As Long ' just a loop variable
Dim oDlg As Dialog
Dim oString As String
ResetFRParameters
ActiveDocument.Range(0, 0).Select
Selection.ExtendMode = False
Set oDlg = Dialogs(wdDialogEditReplace)
On Error Resume Next
oDlg.Find = "a"
oDlg.Replace = "a"
oString = oDlg.Find
oDlg.ReplaceAll = True
SendKeys "%m"
SendKeys "%y"
SendKeys "%a"
SendKeys "{tab}"
SendKeys "{tab}"
SendKeys "{tab}"
SendKeys "{enter}"
oDlg.Display
sl = Err.Description
For l = 1 To Len(sl)
If IsNumeric(Mid(sl, l, 1)) Then
ss = ss & Mid(sl, l, 1)
End If
Next
ResetFRParameters
MsgBox oString & ": was found (" & ss & ") times"
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
.Execute
End With
End Sub

 

[Helmut Weber]

Hi Ricardo,

my attempt was meant as a standalone macro,
for counting the number of occurences
of a single word or whatever
only every now and then with varying options.

I'd use "range.find", if options had to be defined,
and instr, replace etc. in other cases.
Maybe "Ubound" of "split", too,
depending on size and structure of the doc.

The strange thing about the error is,
that it seems to be immanent, in a way.
A search stops when no more occurences are to be found,
and this constitutes the error...

Mere speculation, of course.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Greg Maxey]

Ricardo,

How about an input box to set the .Find value and simply using ^& as
the replace variable:

Sub test()
Dim ss As String ' short string, the number of replacements
Dim sl As String ' long string, the error message
Dim l As Long ' just a loop variable
Dim oDlg As Dialog
Dim oFind As String
Dim oString As String
ResetFRParameters
ActiveDocument.Range(0, 0).Select
Selection.ExtendMode = False
oFind = InputBox("Type the word to find:")
Set oDlg = Dialogs(wdDialogEditReplace)
On Error Resume Next
oDlg.Find = oFind
oDlg.Replace = "^&"
oString = oDlg.Find
oDlg.ReplaceAll = True
SendKeys "%m"
SendKeys "%y"
SendKeys "%a"
SendKeys "{tab}"
SendKeys "{tab}"
SendKeys "{tab}"
SendKeys "{enter}"
oDlg.Display
sl = Err.Description
For l = 1 To Len(sl)
If IsNumeric(Mid(sl, l, 1)) Then
ss = ss & Mid(sl, l, 1)
End If
Next
ResetFRParameters
MsgBox oString & ": was found (" & ss & ") times"
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
.Execute
End With
End Sub

 

[Helmut Weber]

Hi Greg,

hmm...,
you've read my other posting in the meantime, I guess.

I thought about letting the user fill in what he was searching for.
Ideally, the macro would set oDlg.replace to oDlg.find automatically
and, of course, you know about sendkeys.

Thinking one step further, IMHO,
with options we will arrive at range.find or range.replace anyway,
and would have to replace the poorly documented dialog
by a userform of our own.

By hindsight,
it is all about that search always results in an error,
and that the messagebox, Word presents after a search,
is the error message.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Greg Maxey]

Of course. Interesting discovery about the error.

 

[George Lee]

One of the posters has a point. The Search dialog keeps displaying and is an
interface nuisance. Is there a way to keep the dialog from showing up?

 

[Helmut Weber]

Hi George,

if you need user interaction,
then you need some kind of a a dialog.

If you don't need user interaction,
then it is all about
instr or replace or split or whatever without formatting,
and range.find with or without formatting,
as other posters have pointed out.

Maye be there was a sample with just "find" missing, like:

Sub Macro4()
Dim rDcm As Range
Dim l As Long
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = "brown"
.Font.Name = "Times New Roman"
.Format = True
While .Execute
l = l + 1
Wend
End With
MsgBox l
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[paulag1955]

Here is a related question:

Is it then possible to take the answer (the number of occurrences), compare
it to the number of pages in the document, then either display a message box
showing the number of occurrences OR solicit input from the user, then add a
line of text to the document?

 

[Jezebel]

Yes.

Here is a related question:

Is it then possible to take the answer (the number of occurrences),
compare
it to the number of pages in the document, then either display a message
box
showing the number of occurrences OR solicit input from the user, then add
a
line of text to the document?