Counting word occurences: a VBA code gives wrong count

[Ernie]

Counting number of word occurrences in a Microsoft document

This is VBA code for counting occurrences of a name in a table in a
Microsoft document. Attached are 2 files: <Counters Name List proc1 VBA.doc>
(this is the good one) and <Counters Name List proc2 VBA – Modified.doc>,
with the more elegant code but giving incorrect results. Of course, the
buttons don’t work in this submission.

As you will see, the document consists of 3 parts. The first part is an
introductory paragraph ending with my name Ernie. The next is the Schedule
table referred to as Tables(1) and the last NameList is referred to as
Tables(2). The code behind <Counters Name List proc1 VBA.doc> works well and
populates NameList with the correct counts for each name listed, 48 instances
in total.

<Counters Name List proc2 VBA – Modified.doc> has a more “elegant†code,
i.e., using a function and a couple of calls. However, it doesn’t work! One
problem [the inclusion of Tables(2) in the count] was fixed by specifying a
backwards search using .Forward = False. This prevents it from including in
the count the names in the NameList but the topmost Ernie in the introduction
is then included in the count.

I tried making the introduction Tables(1) and renumbering the remaining two.
That didn’t work either!

It appears that Range statement within the function: With tSearch.Range.Find
somehow destroys the Tables() specification even though wtSchedule is passed
as an argument having been Set as ActiveDocument.Tables(1)…or Tables(2).

While this is sort of an “academic†problem and probably points out my lack
of understanding of the subtly of VBA, it points out how dangerous simple
code can be in the sense that it doesn’t function, as one would think it
should. How many codes are in use that don’t always give the correct answer?
Regards,
Ernest Lippert



<Counters Name List proc1 VBA.doc>
<Counters Name List proc2 VBA – Modified.doc>

Counting Schedule PROCEDURE 1

If you can’t count on any of your assigned dates at 9:00 am, either call me
or find a replacement. Thanks, Ernie

September 8 Ernie no show
15 Tom David
22 Ernie Chuck
29 Ernie Mary Ann
October 6 Mary Andy
13 Mary Chuck
20 Dick David
27 Mary Tom
November 3 Tom Chuck
10 Mary Ann Andy
17 Mary Andy
24 Dick David
December 1 Andy Dick
8 Tom Mary
15 Mary Ann Chuck
22 Mary Ann Ernie
29 Dick Chuck
January 5 David Ernie
12 David Tom
19 Andy Ernie
26 Dick Chuck
February 2 Mary Dick
9 David Andy
16 Tom Mary Ann


Andy 6
Chuck 6
David 6
Dick 6
Ernie 6
Mary 11
no show 1
Tom 6
7
48



<Counters Name List proc1 VBA.doc> This procedure gives the correct count, 48


Option Explicit

Private Sub CommandButton4_Click()

Dim Schedule As Document
Dim NameList As Document
Dim i As Long, j As Long
Dim dName As Range
Set Schedule = ActiveDocument
Set NameList = ActiveDocument

NameList.Activate

For i = 1 To (NameList.Tables(2).Rows.count - 1)
NameList.Tables(2).Cell(i, 2).Select
Selection.Delete
Next i

Schedule.Tables(1).Select


For i = 1 To (NameList.Tables(2).Rows.count - 1)
Set dName = NameList.Tables(2).Cell(i, 1).Range
dName.End = dName.End - 1
Schedule.Tables(1).Select
Selection.Find.ClearFormatting
j = -1
With Selection.Find
Do While .Execute(FindText:=dName.Text, _
MatchWildcards:=False, MatchCase:=True, _
Wrap:=wdFindStop, MatchWholeWord:=True, _
Forward:=True) = True

j = j + 1
Loop
End With
NameList.Tables(2).Cell(i, 2).Range.InsertBefore j
Next i

NameList.Activate

NameList.Tables(2).Cell(i, 1).Range.Fields.Update
NameList.Tables(2).Cell(i, 2).Range.Fields.Update


End Sub


Counting Schedule PROCEDURE 2 **problem**

If you can’t count on any of your assigned dates at 9:00 am, either call me
or find a replacement. Thanks, Ernie This name instance should not be
counted.

September 8 Ernie no show
15 Tom David
22 Ernie Chuck
29 Ernie Mary
October 6 Mary Andy
13 Mary Chuck
20 Dick David
27 Mary Tom
November 3 Tom Chuck
10 Mary Andy
17 Mary Andy
24 Dick David
December 1 Andy Dick
8 Tom Mary
15 Mary Chuck
22 Mary Ernie
29 Dick Chuck
January 5 David Ernie
12 David Tom
19 Andy Ernie
26 Dick Chuck
February 2 Mary Dick
9 David Andy
16 Tom Mary


Andy 6
Chuck 6
David 6
Dick 6
Ernie 7 Number should be 6
Mary 11
no show 1
Tom 6
7
49


<Counters Name List proc2 VBA – Modified.doc> This procedures gives an
incorrect count of 49.

Option Explicit

Private Sub CommandButton4_Click()

Dim Schedule As Document
Dim wtSchedule As Word.Table
' Dim NameList As Document ' not really needed since you can just use
ActiveDocument
Dim i As Integer
Dim wtVolunteers As Word.Table
Set wtVolunteers = ActiveDocument.Tables(2)
Set wtSchedule = ActiveDocument.Tables(1)

' Clears update table
Call ClearTotals

With wtVolunteers
' for each row in the volunteers table, count the # of occurances
For i = 1 To .Rows.Count - 1
.Cell(i, 2).Range.Text = iCountOccurances(.Cell(i, 1).Range.Text,
wtSchedule)
Next i
End With

' Reset the Formulas for the last row and update the values
Call UpdateTotals

End Sub

Function iCountOccurances(sName As String, wtSchedule) As Integer
Dim tSearch As Object
Dim i As Integer

iCountOccurances = 0
sName = Left(sName, Len(sName) - 2)

'Set tSearch = ActiveDocument.Tables(1)
Set tSearch = wtSchedule
With tSearch.Range.Find
.Forward = False ' for some reason, when you search forward it also
checks Table(2)
.ClearFormatting
.MatchWholeWord = True
.MatchCase = True
.Wrap = wdFindStop
.Text = sName
Do While .Execute = True
iCountOccurances = iCountOccurances + 1
Loop
End With

End Function
Sub UpdateTotals()
Dim wtTotals As Word.Table
Set wtTotals = ActiveDocument.Tables(2)
With wtTotals
.Cell(.Rows.Count, 2).Formula Formula:="=SUM(ABOVE)"
.Cell(.Rows.Count, 2).Range.Fields.Update
.Cell(.Rows.Count, 1).Formula Formula:="=COUNT(ABOVE)-1"
.Cell(.Rows.Count, 1).Range.Fields.Update
End With
End Sub


Sub ClearTotals()
Dim i As Integer
Dim wtTotals As Word.Table
Set wtTotals = ActiveDocument.Tables(2)
With wtTotals
For i = 1 To (.Rows.Count - 1)
.Cell(i, 2).Range.Text = ""
Next i
End With
Call UpdateTotals
End Sub

 

[Neil Cumfer]

Your second procedure will produce the result you desire if you set the
counter to start at -1, like you did in the first procedure, and also
use .Forward=True, like you did in the first procedure.

In your first procedure, you used: j = -1
In you second procedure, you used: iCountOccurances = 0

In either case, the names in Table 2 are counted, in addition to the
names in Table 1, but by starting at -1 you are effectively subtracting
them after they are counted.

As you have found, when you use .Forward=False, then name Ernie in the
top portion is also counted, but since you make no subtraction for that,
the final count for that name is not the result that you desire.

The reason your procedures are not working as expected is because when
the .Execute statment of the Find object finds a match, the parent
selection or range of the Find object is redefined. Therefore, when you
use the .Execute statement the second time to find another match, it
does not operate on the same selection or range as it did originally.

There is an explanation and sample code the the Word MVP web site, I'm
sorry I don't have the exact URL. I think the solution involves the use
of 2 ranges.

You asked: How many codes are in use that don’t always give the correct
answer?

There are many many codes where the documentation is inadequate and in a
few isolated instances it is just plain erroneous. Be prepared to do a
lot of experimentation and testing with any VBA code you write or
modify.

Counting number of word occurrences in a Microsoft document

This is VBA code for counting occurrences of a name in a table in a
Microsoft document. Attached are 2 files: <Counters Name List proc1 VBA.doc>
(this is the good one) and <Counters Name List proc2 VBA – Modified.doc>,
with the more elegant code but giving incorrect results. Of course, the
buttons don’t work in this submission.

As you will see, the document consists of 3 parts. The first part is an
introductory paragraph ending with my name Ernie. The next is the Schedule
table referred to as Tables(1) and the last NameList is referred to as
Tables(2). The code behind <Counters Name List proc1 VBA.doc> works well and
populates NameList with the correct counts for each name listed, 48 instances
in total.

<Counters Name List proc2 VBA – Modified.doc> has a more “elegant†code,
i.e., using a function and a couple of calls. However, it doesn’t work! One
problem [the inclusion of Tables(2) in the count] was fixed by specifying a
backwards search using .Forward = False. This prevents it from including in
the count the names in the NameList but the topmost Ernie in the introduction
is then included in the count.

I tried making the introduction Tables(1) and renumbering the remaining two.
That didn’t work either!

It appears that Range statement within the function: With tSearch.Range.Find
somehow destroys the Tables() specification even though wtSchedule is passed
as an argument having been Set as ActiveDocument.Tables(1)…or Tables(2).

While this is sort of an “academic†problem and probably points out my lack
of understanding of the subtly of VBA, it points out how dangerous simple
code can be in the sense that it doesn’t function, as one would think it
should. How many codes are in use that don’t always give the correct answer?
Regards,
Ernest Lippert



<Counters Name List proc1 VBA.doc>
<Counters Name List proc2 VBA – Modified.doc>

Counting Schedule PROCEDURE 1

If you can’t count on any of your assigned dates at 9:00 am, either call me
or find a replacement. Thanks, Ernie

September 8 Ernie no show
15 Tom David
22 Ernie Chuck
29 Ernie Mary Ann
October 6 Mary Andy
13 Mary Chuck
20 Dick David
27 Mary Tom
November 3 Tom Chuck
10 Mary Ann Andy
17 Mary Andy
24 Dick David
December 1 Andy Dick
8 Tom Mary
15 Mary Ann Chuck
22 Mary Ann Ernie
29 Dick Chuck
January 5 David Ernie
12 David Tom
19 Andy Ernie
26 Dick Chuck
February 2 Mary Dick
9 David Andy
16 Tom Mary Ann


Andy 6
Chuck 6
David 6
Dick 6
Ernie 6
Mary 11
no show 1
Tom 6
7
48



<Counters Name List proc1 VBA.doc> This procedure gives the correct count, 48


Option Explicit

Private Sub CommandButton4_Click()

Dim Schedule As Document
Dim NameList As Document
Dim i As Long, j As Long
Dim dName As Range
Set Schedule = ActiveDocument
Set NameList = ActiveDocument

NameList.Activate

For i = 1 To (NameList.Tables(2).Rows.count - 1)
NameList.Tables(2).Cell(i, 2).Select
Selection.Delete
Next i

Schedule.Tables(1).Select


For i = 1 To (NameList.Tables(2).Rows.count - 1)
Set dName = NameList.Tables(2).Cell(i, 1).Range
dName.End = dName.End - 1
Schedule.Tables(1).Select
Selection.Find.ClearFormatting
j = -1
With Selection.Find
Do While .Execute(FindText:=dName.Text, _
MatchWildcards:=False, MatchCase:=True, _
Wrap:=wdFindStop, MatchWholeWord:=True, _
Forward:=True) = True

j = j + 1
Loop
End With
NameList.Tables(2).Cell(i, 2).Range.InsertBefore j
Next i

NameList.Activate

NameList.Tables(2).Cell(i, 1).Range.Fields.Update
NameList.Tables(2).Cell(i, 2).Range.Fields.Update


End Sub


Counting Schedule PROCEDURE 2 **problem**

If you can’t count on any of your assigned dates at 9:00 am, either call me
or find a replacement. Thanks, Ernie This name instance should not be
counted.

September 8 Ernie no show
15 Tom David
22 Ernie Chuck
29 Ernie Mary
October 6 Mary Andy
13 Mary Chuck
20 Dick David
27 Mary Tom
November 3 Tom Chuck
10 Mary Andy
17 Mary Andy
24 Dick David
December 1 Andy Dick
8 Tom Mary
15 Mary Chuck
22 Mary Ernie
29 Dick Chuck
January 5 David Ernie
12 David Tom
19 Andy Ernie
26 Dick Chuck
February 2 Mary Dick
9 David Andy
16 Tom Mary


Andy 6
Chuck 6
David 6
Dick 6
Ernie 7 Number should be 6
Mary 11
no show 1
Tom 6
7
49


<Counters Name List proc2 VBA – Modified.doc> This procedures gives an
incorrect count of 49.

Option Explicit

Private Sub CommandButton4_Click()

Dim Schedule As Document
Dim wtSchedule As Word.Table
' Dim NameList As Document ' not really needed since you can just use
ActiveDocument
Dim i As Integer
Dim wtVolunteers As Word.Table
Set wtVolunteers = ActiveDocument.Tables(2)
Set wtSchedule = ActiveDocument.Tables(1)

' Clears update table
Call ClearTotals

With wtVolunteers
' for each row in the volunteers table, count the # of occurances
For i = 1 To .Rows.Count - 1
.Cell(i, 2).Range.Text = iCountOccurances(.Cell(i, 1).Range.Text,
wtSchedule)
Next i
End With

' Reset the Formulas for the last row and update the values
Call UpdateTotals

End Sub

Function iCountOccurances(sName As String, wtSchedule) As Integer
Dim tSearch As Object
Dim i As Integer

iCountOccurances = 0
sName = Left(sName, Len(sName) - 2)

'Set tSearch = ActiveDocument.Tables(1)
Set tSearch = wtSchedule
With tSearch.Range.Find
.Forward = False ' for some reason, when you search forward it also
checks Table(2)
.ClearFormatting
.MatchWholeWord = True
.MatchCase = True
.Wrap = wdFindStop
.Text = sName
Do While .Execute = True
iCountOccurances = iCountOccurances + 1
Loop
End With

End Function
Sub UpdateTotals()
Dim wtTotals As Word.Table
Set wtTotals = ActiveDocument.Tables(2)
With wtTotals
.Cell(.Rows.Count, 2).Formula Formula:="=SUM(ABOVE)"
.Cell(.Rows.Count, 2).Range.Fields.Update
.Cell(.Rows.Count, 1).Formula Formula:="=COUNT(ABOVE)-1"
.Cell(.Rows.Count, 1).Range.Fields.Update
End With
End Sub


Sub ClearTotals()
Dim i As Integer
Dim wtTotals As Word.Table
Set wtTotals = ActiveDocument.Tables(2)
With wtTotals
For i = 1 To (.Rows.Count - 1)
.Cell(i, 2).Range.Text = ""
Next i
End With
Call UpdateTotals
End Sub