Macro Assessment

[Greg]

I scratched together the following macro earlier today to help and
Tables Group OP with a question for population a freight shipping
scale. The OP scale has four columns 1)weight in 100 lbs increments,
2) a flat fee, 3) a rate, and 4) total. He needed a scale from 100 to
80,000 pounds. He has the 801 row table with the headings. Here is
the code:

Sub FillinRateScale()
Dim oTbl As Table
Dim i As Long
Dim x As Double
Dim y As Double
Set oTbl = ActiveDocument.Tables(1)
For i = 2 To oTbl.Rows.Count
With oTbl
.Cell(i, 1).Range.Text = (100 * i) - 100
.Cell(i, 2).Range.Text = "$160.00"
.Cell(i, 3).Range.Text = Format((3 * i) - 3, "$#,###.00")
x = Left(.Cell(i, 2).Range, Len(.Cell(i, 2).Range) - 2)
y = Left(.Cell(i, 3).Range, Len(.Cell(i, 3).Range) - 2)
.Cell(i, 4).Range = Format(x + y, "$#,###.00")
End With
Next
End Sub

On my machine here it took 103 seconds to populate the table. I
thought I would get a noticeable reduction in time if I changed:

For i = 2 to oTbl.Rows.Count
to
For i = 2 to 801 'Since I know the number of rows and the macro would
not have to recount each time. While I didn't measure precisely, I
didn't see any reduction in time.

Would welcome comment on ways to make this sort of thing run faster.
Thanks.

 

[Helmut Weber]

Hi Greg,

there is no recounting, if I am right ;-)

Sub NotEndless()
Dim i As Long
Dim oTbl As Table
Set oTbl = ActiveDocument.Tables(1)
For i = 1 To oTbl.Rows.Count
MsgBox oTbl.Rows.Count ' increases
' still not endless as
' oTbl.Rows.Count in for ... to doesn't, obviously
oTbl.Rows.Add
Next
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

 

[Greg]

Helmut,

Sure seems that you are right.

Thanks.

 

[Jezebel]

This change --

For i = 2 to oTbl.Rows.Count
to
For i = 2 to 801

Makes no difference because VB evaluates the for loop indexes only once, not
once for each iteration. Try this

p = 5
For i = 1 to p
p = i * 2
debug.print i,p
Next



What might make a measureable difference is to remove some of those cells
references --

Dim pCell2 as Word.Range
Dim pCell3 as Word.Range

With oTbl

For i = 2 To oTbl.Rows.Count
.Cell(i, 1).Range = (100 * i) - 100

set pCell2 = .Cell(i, 2).Range
set pCell3 = .Cell(i, 3).Range
pCell2 = "$160.00"
pCell3 = Format((3 * i) - 3, "$#,###.00")
x = Left$(pCell2, Len(pCell2) - 2)
y = Left$(pCell3, Len(pCell2) - 3)
.Cell(i, 4).Range = Format$(x + y, "$#,###.00")
Next

End With

 

[Helmut Weber]

Hi Greg, hi Jezebel,

running the macro, as Greg provided it, took 8 seconds.
here and now, for a 100 rows table,
with your appreciated advice, it took 6 seconds.
When using an array of cells, it takes less than 5 seconds.

Sub FillinRateScale()
Dim t As Double
t = CDbl(Now)

Dim oTbl As Table
Dim i As Long
Dim x As Double
Dim y As Double
Dim pCell(1 To 4) As Cell

Set oTbl = ActiveDocument.Tables(1)
For i = 2 To oTbl.Rows.Count
With oTbl
Set pCell(1) = .Cell(i, 1)
Set pCell(2) = .Cell(i, 2)
Set pCell(3) = .Cell(i, 3)
Set pCell(4) = .Cell(i, 4)
pCell(1).Range.Text = (100 * i) - 100
pCell(2).Range.Text = "$160.00"
pCell(3).Range.Text = Format((3 * i) - 3, "$#,###.00")
x = Left(.Cell(i, 2).Range, Len(.Cell(i, 2).Range) - 2)
y = Left(.Cell(i, 3).Range, Len(.Cell(i, 3).Range) - 2)
pCell(4).Range.Text = Format(x + y, "$#,###.00")
End With
Next

MsgBox Format(CLng(Now) - t, "0.0000")
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

 

[Helmut Weber]

....

and with using consequently a cell from the array of cells,
I get it down to about 4.5 seconds:

Plus Application.WindowState = wdWindowStateMinimize
gets close to 4 seconds.


Sub FillinRateScale()
Application.WindowState = wdWindowStateMinimize
Dim t As Double
t = CDbl(Now)

Dim oTbl As Table
Dim i As Long
Dim x As Double
Dim y As Double
Dim pCell(1 To 4) As Cell

Set oTbl = ActiveDocument.Tables(1)
For i = 2 To oTbl.Rows.Count
With oTbl
Set pCell(1) = .Cell(i, 1)
Set pCell(2) = .Cell(i, 2)
Set pCell(3) = .Cell(i, 3)
Set pCell(4) = .Cell(i, 4)
pCell(1).Range.Text = (100 * i) - 100
pCell(2).Range.Text = "$160.00"
pCell(3).Range.Text = Format((3 * i) - 3, "$#,###.00")
x = Left(pCell(2).Range, Len(pCell(2).Range) - 2)
y = Left(pCell(3).Range, Len(pCell(3).Range) - 2)
pCell(4).Range.Text = Format(x + y, "$#,###.00")
End With
Next
Application.WindowState = wdWindowStateMaximize
MsgBox Format(CLng(Now) - t, "0.0000")
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

 

[Helmut Weber]

Hi,

really thrilling,

if I assign oTbl.Rows.Count to a variable,
and use that variable in the for ... next loop,
I get the time down to near to 3 seconds.

Set oTbl = ActiveDocument.Tables(1)
z = oTbl.Rows.Count

For i = 2 To z
[...]
next

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

 

[Greg Maxey]

Helmut,

Sounds like your gears are really meshing and spinning. Thanks for the
refinements.

 

[Greg Maxey]

Thanks,

 

[Helmut Weber]

Hi Greg,

Sounds like your gears are really meshing and spinning.

My gears are meshing and spinning on and on ;-)

Makes no difference because VB evaluates the for loop indexes
only once, not once for each iteration.

I think both, Jezebel and me were wrong.

There is recounting sometimes, at least here:

Sub Test8888()
Dim l As Long
Dim oSggs As SpellingSuggestions
With ActiveDocument.SpellingErrors
For l = 1 To .Count
MsgBox .Count
Set oSggs = .Item(l).GetSpellingSuggestions
If oSggs.Count <> 0 Then
If LCase(oSggs(1).Name) = .Item(l).Text Then
.Item(l).Text = oSggs(1).Name
End If
End If
Next
End With
End Sub

The sample text is:

this is greg and this is walter und this is mr. gregory.

The purpose af the exercise was to capitalize proper names.

Works only if counting backwards:
For l = .Count To 1 Step -1

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

 

[Jay Freedman]

Hi Greg,


My gears are meshing and spinning on and on ;-)


I think both, Jezebel and me were wrong.

There is recounting sometimes, at least here:

Sub Test8888()
Dim l As Long
Dim oSggs As SpellingSuggestions
With ActiveDocument.SpellingErrors
For l = 1 To .Count
MsgBox .Count
Set oSggs = .Item(l).GetSpellingSuggestions
If oSggs.Count <> 0 Then
If LCase(oSggs(1).Name) = .Item(l).Text Then
.Item(l).Text = oSggs(1).Name
End If
End If
Next
End With
End Sub

The sample text is:

this is greg and this is walter und this is mr. gregory.

The purpose af the exercise was to capitalize proper names.

Works only if counting backwards:
For l = .Count To 1 Step -1

Hi Helmut & Greg,

This is a more-subtle case of what happens when a loop using a counter
deletes some of the items in a collection. When the first line of the For
loop executes, the start and stop values of the loop index (in this case 1
and .Count) are computed and stored. They're never re-evaluated after that.
So with Helmut's example sentence, where the initial .Count is 4, the loop
is guaranteed to run 4 times. [I was a little surprised that my English
(US) version of Word didn't mark 'und' as a spelling error -- maybe, like
me, it knows just a little Deutsch. <g>]

Each time the line .Item(l).Text = oSggs(1).Name executes, one of the items
is removed from the collection (that is, it's no longer 'wrong'). That
causes .Count to be decremented by 1 -- but that does *not* affect the stop
value of the loop index. At some point (when the loop index becomes 3 or 4
in this example) the value of the loop index becomes larger than the current
size of the collection, at which point VBA throws an error when it tries to
refer to .Items(l).

One way to avoid this is to count backwards as Helmut says, so the items
being deleted are always the ones nearest the end of the document. Another
way for *most* (but, sadly, not all) collections is to use a For Each loop
instead of an indexed loop. This version runs correctly:

Sub Test9999()
Dim oErr As Range
Dim oSggs As SpellingSuggestions

For Each oErr In ActiveDocument.SpellingErrors
Set oSggs = oErr.GetSpellingSuggestions
If oSggs.Count <> 0 Then
If LCase(oSggs(1).Name) = oErr.Text Then
oErr.Text = oSggs(1).Name
End If
End If
Next
End Sub

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

 

[Helmut Weber]

Yes!



Thanks Jay

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

 

[Greg Maxey]

Jay,

Yes, I think you have taught me a similar lesson once before ;-)

I haven't tried to find out why, but the code doesn't correct the "mr."
I also found it interesting that the code processes greg, then gregory, then
mr, and finally walter. The spelling errors must be indexed alphabetically.



--
Greg Maxey/Word MVP
See:
http://gregmaxey.mvps.org/word_tips.htm
For some helpful tips using Word.

Hi Greg,


My gears are meshing and spinning on and on ;-)


I think both, Jezebel and me were wrong.

There is recounting sometimes, at least here:

Sub Test8888()
Dim l As Long
Dim oSggs As SpellingSuggestions
With ActiveDocument.SpellingErrors
For l = 1 To .Count
MsgBox .Count
Set oSggs = .Item(l).GetSpellingSuggestions
If oSggs.Count <> 0 Then
If LCase(oSggs(1).Name) = .Item(l).Text Then
.Item(l).Text = oSggs(1).Name
End If
End If
Next
End With
End Sub

The sample text is:

this is greg and this is walter und this is mr. gregory.

The purpose af the exercise was to capitalize proper names.

Works only if counting backwards:
For l = .Count To 1 Step -1

Hi Helmut & Greg,

This is a more-subtle case of what happens when a loop using a counter
deletes some of the items in a collection. When the first line of the
For loop executes, the start and stop values of the loop index (in
this case 1 and .Count) are computed and stored. They're never
re-evaluated after that. So with Helmut's example sentence, where the
initial .Count is 4, the loop is guaranteed to run 4 times. [I was a
little surprised that my English (US) version of Word didn't mark
'und' as a spelling error -- maybe, like me, it knows just a little
Deutsch. <g>]

Each time the line .Item(l).Text = oSggs(1).Name executes, one of the
items is removed from the collection (that is, it's no longer
'wrong'). That causes .Count to be decremented by 1 -- but that does
*not* affect the stop value of the loop index. At some point (when
the loop index becomes 3 or 4 in this example) the value of the loop
index becomes larger than the current size of the collection, at
which point VBA throws an error when it tries to refer to .Items(l).

One way to avoid this is to count backwards as Helmut says, so the
items being deleted are always the ones nearest the end of the
document. Another way for *most* (but, sadly, not all) collections is
to use a For Each loop instead of an indexed loop. This version runs
correctly:

Sub Test9999()
Dim oErr As Range
Dim oSggs As SpellingSuggestions

For Each oErr In ActiveDocument.SpellingErrors
Set oSggs = oErr.GetSpellingSuggestions
If oSggs.Count <> 0 Then
If LCase(oSggs(1).Name) = oErr.Text Then
oErr.Text = oSggs(1).Name
End If
End If
Next
End Sub

 

[Greg Maxey]

Jay,

I thought that this would do it:
Sub Test9999()
Dim oErr As Range
Dim oSggs As SpellingSuggestions
Dim i As Long
For Each oErr In ActiveDocument.SpellingErrors
Set oSggs = oErr.GetSpellingSuggestions
Select Case oSggs.Count
Case Is <> 0
For i = 1 To oErr.GetSpellingSuggestions.Count
If LCase(oSggs(i).Name) Like oErr.Text Then
oErr.Text = oSggs(i).Name
Exit For
End If
Next
End Select
Next
End Sub

However, it appears that for "mr." the oErr.Text is "mr" while the
appropriate LCase(Sggs(i).Name) is "mr." Therefore they won't ever match.

The above code does handle a proper name like mary.



--
Greg Maxey/Word MVP
See:
http://gregmaxey.mvps.org/word_tips.htm
For some helpful tips using Word.

Hi Greg,


My gears are meshing and spinning on and on ;-)


I think both, Jezebel and me were wrong.

There is recounting sometimes, at least here:

Sub Test8888()
Dim l As Long
Dim oSggs As SpellingSuggestions
With ActiveDocument.SpellingErrors
For l = 1 To .Count
MsgBox .Count
Set oSggs = .Item(l).GetSpellingSuggestions
If oSggs.Count <> 0 Then
If LCase(oSggs(1).Name) = .Item(l).Text Then
.Item(l).Text = oSggs(1).Name
End If
End If
Next
End With
End Sub

The sample text is:

this is greg and this is walter und this is mr. gregory.

The purpose af the exercise was to capitalize proper names.

Works only if counting backwards:
For l = .Count To 1 Step -1

Hi Helmut & Greg,

This is a more-subtle case of what happens when a loop using a counter
deletes some of the items in a collection. When the first line of the
For loop executes, the start and stop values of the loop index (in
this case 1 and .Count) are computed and stored. They're never
re-evaluated after that. So with Helmut's example sentence, where the
initial .Count is 4, the loop is guaranteed to run 4 times. [I was a
little surprised that my English (US) version of Word didn't mark
'und' as a spelling error -- maybe, like me, it knows just a little
Deutsch. <g>]

Each time the line .Item(l).Text = oSggs(1).Name executes, one of the
items is removed from the collection (that is, it's no longer
'wrong'). That causes .Count to be decremented by 1 -- but that does
*not* affect the stop value of the loop index. At some point (when
the loop index becomes 3 or 4 in this example) the value of the loop
index becomes larger than the current size of the collection, at
which point VBA throws an error when it tries to refer to .Items(l).

One way to avoid this is to count backwards as Helmut says, so the
items being deleted are always the ones nearest the end of the
document. Another way for *most* (but, sadly, not all) collections is
to use a For Each loop instead of an indexed loop. This version runs
correctly:

Sub Test9999()
Dim oErr As Range
Dim oSggs As SpellingSuggestions

For Each oErr In ActiveDocument.SpellingErrors
Set oSggs = oErr.GetSpellingSuggestions
If oSggs.Count <> 0 Then
If LCase(oSggs(1).Name) = oErr.Text Then
oErr.Text = oSggs(1).Name
End If
End If
Next
End Sub

 

[Jay Freedman]

Hi Greg,

If you want to chase this down to the bitter end, the next step is to remove
any dot from the suggestion:

Sub Test10000()
Dim oErr As Range
Dim oSggs As SpellingSuggestions
Dim i As Long
Dim strSgg
For Each oErr In ActiveDocument.SpellingErrors
Set oSggs = oErr.GetSpellingSuggestions
If oSggs.Count <> 0 Then
For i = 1 To oErr.GetSpellingSuggestions.Count
strSgg = Replace(oSggs(i).Name, ".", "")
If LCase(strSgg) = oErr.Text Then
oErr.Text = strSgg
Exit For
End If
Next i
End If
Next oErr
End Sub

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

 

[Greg]

Jay,

I gave up on the bitter end in this case. I thought about something
like you demonstrated above, but then realized that Word doesn't
recognize names like smith, miller, etc. as errors or some abbreviated
titles e.g., dr.

Thanks just the same. I am still learning and you are always teaching.

 

[Helmut Weber]

Hi Greg,

I gave up on the bitter end in this case. I thought about something
like you demonstrated above, but then realized that Word doesn't
recognize names like smith, miller, etc. as errors or some abbreviated
titles e.g., dr.

originally my code was an attempt to help a german user
in capitalizing nouns. If it worked in 50 percent of the cases,
produced only 10 percent additional mistakes, then I'd say,
that was all he could expect.

Cheers

Helmut

 

[Greg Maxey]

It's a fine code Helmut ;-). Actually I thought that you had just thrown it
out as an example of the .Count issue.