Slow Code Execution

[spunkymuffmonkey]

Hi all,

I have a some code that I am using to read the contents of each cell of the
multiple rows in a 4 columned table.

I am experiencing a slow down when my code gets to a particular line of code
with is:

Set myRange = oTable.Rows(i).Cells(j).Range

when the table contains less than 100 rows the macro flies along really
quickly, however when the number of rows is increased to 500 or so, my code
grinds to a snail's pace, but strangely (at least in my eyes) this slowdown
occurs on the very first line in the table.row.count is high (I would've
thought that the code would start struggling after executing a few times.

Could anybody shed any light on this, and also point me in the direction of
some information surrounding the memory utilisation of vba as I am creating
more and more complex coding without any understanding of the implications of
my designs.

Many thanks for looking.

 

[Greg Maxey]

Hard to say without seeing your entire code.

I haven't had any formal training and the little I know has been gained from
trail and error, some of it painful ;-), and spoon feeding by many of the
Titans of VBA posting here.

I can pass on that minimizing what process has to figure out and have often
it must figure it out can help. For example:

For i = 1 to ActiveDocument.Tables(1).Rows.Count
'Do this
Next i

If the table has 5 rows then that is being determined each time the For
statement runs.

Better (IMHO) to do something like

lngRowCount = ActiveDocument.Tables(1).Rows.Count

For i = 1 to lngRowCount
'Do this
Next i

That only has to be figured once.

As a demo I created a 4 col 600 row table fille with text (just "Cell and a
number) and ran the following code. The time to run was 24 seconds and 15
seconds. Pretty good gain in efficiency ;-)

Do you need to use the Set statement?



Option Explicit
Sub Demo()
Dim t As Single
Dim i As Long
t = Timer
FillArray ActiveDocument.Tables(1)
t = Timer - t
MsgBox "The macro took " & t & " seconds."
t = Timer
FillArrayFaster ActiveDocument.Tables(1)
t = Timer - t
MsgBox "The macro took " & t & " seconds."
End Sub
Sub FillArray(ByRef oTable As Table)
Dim arrReplace() As String
Dim i As Long, j As Long
'Dimension array to hold table row and column data
ReDim arrReplace(oTable.Rows.Count - 1, oTable.Columns.Count - 1)
'Load data from rows
For i = 0 To oTable.Rows.Count - 1
For j = 0 To oTable.Columns.Count - 1
'Use function to strip end of cell marker and load only text
arrReplace(i, j) = fcnCellText(oTable.Cell(i + 1, j + 1).Range.Text)
Next
Next
End Sub
Sub FillArrayFaster(ByRef oTable As Table)
Dim arrReplace() As String
Dim i As Long, j As Long, oRowCount As Long, oColCount As Long
oRowCount = oTable.Rows.Count: oColCount = oTable.Columns.Count
'Dimension array to hold table row and column data
ReDim arrReplace(oRowCount - 1, oColCount - 1)
'Load data from rows
For i = 0 To oRowCount - 1
For j = 0 To oColCount - 1
'Use function to strip end of cell marker and load only text
arrReplace(i, j) = fcnCellText(oTable.Cell(i + 1, j + 1).Range.Text)
Next
Next
End Sub
Function fcnCellText(ByRef pStr As String)
fcnCellText = Left(pStr, Len(pStr) - 2)
End Function

 

[Fumei2 via OfficeKB.com]

I agree it is hard to say without seeing the whole code. Some comments
though:

1. Why are you using a Range like that? Is it really needed? Setting a
range object for each cell...yikes.

2. Perhaps use a For Each...

Function CellText(oCell As Cell)
CellText = Left(oCell.Range.Text, _
Len(oCell.Range.Text) - 2)
End Function

Sub TableStuff()
Dim oTable As Table
Dim oCell As Cell

Set oTable = ActiveDocument.Tables(1)
For Each oCell In oTable.Rows(2).Range.Cells
MsgBox CellText(oCell)
Next
End Sub

Note that I used a slightly different version of Greg's cell text function.
You can pass in either the string of the cell (Greg's version), or in my
version the cell itself.

Greg's version:

Function CellText2(strIn As String)
CellText2 = Left(strIn, Len(strIn) - 2)
End Function

Sub TableStuff()
Dim oTable As Table
Dim oCell As Cell

Set oTable = ActiveDocument.Tables(1)
For Each oCell In oTable.Rows(2).Range.Cells
MsgBox CellText2(oCell.Range.Text)
Next
End Sub


Gerry

Hard to say without seeing your entire code.

I haven't had any formal training and the little I know has been gained from
trail and error, some of it painful ;-), and spoon feeding by many of the
Titans of VBA posting here.

I can pass on that minimizing what process has to figure out and have often
it must figure it out can help. For example:

For i = 1 to ActiveDocument.Tables(1).Rows.Count
'Do this
Next i

If the table has 5 rows then that is being determined each time the For
statement runs.

Better (IMHO) to do something like

lngRowCount = ActiveDocument.Tables(1).Rows.Count

For i = 1 to lngRowCount
'Do this
Next i

That only has to be figured once.

As a demo I created a 4 col 600 row table fille with text (just "Cell and a
number) and ran the following code. The time to run was 24 seconds and 15
seconds. Pretty good gain in efficiency ;-)

Do you need to use the Set statement?

Option Explicit
Sub Demo()
Dim t As Single
Dim i As Long
t = Timer
FillArray ActiveDocument.Tables(1)
t = Timer - t
MsgBox "The macro took " & t & " seconds."
t = Timer
FillArrayFaster ActiveDocument.Tables(1)
t = Timer - t
MsgBox "The macro took " & t & " seconds."
End Sub
Sub FillArray(ByRef oTable As Table)
Dim arrReplace() As String
Dim i As Long, j As Long
'Dimension array to hold table row and column data
ReDim arrReplace(oTable.Rows.Count - 1, oTable.Columns.Count - 1)
'Load data from rows
For i = 0 To oTable.Rows.Count - 1
For j = 0 To oTable.Columns.Count - 1
'Use function to strip end of cell marker and load only text
arrReplace(i, j) = fcnCellText(oTable.Cell(i + 1, j + 1).Range.Text)
Next
Next
End Sub
Sub FillArrayFaster(ByRef oTable As Table)
Dim arrReplace() As String
Dim i As Long, j As Long, oRowCount As Long, oColCount As Long
oRowCount = oTable.Rows.Count: oColCount = oTable.Columns.Count
'Dimension array to hold table row and column data
ReDim arrReplace(oRowCount - 1, oColCount - 1)
'Load data from rows
For i = 0 To oRowCount - 1
For j = 0 To oColCount - 1
'Use function to strip end of cell marker and load only text
arrReplace(i, j) = fcnCellText(oTable.Cell(i + 1, j + 1).Range.Text)
Next
Next
End Sub
Function fcnCellText(ByRef pStr As String)
fcnCellText = Left(pStr, Len(pStr) - 2)
End Function

Hi all,

[quoted text clipped - 19 lines]

Many thanks for looking.

 

[spunkymuffmonkey]

A million thanks indeed for giving me reason to continue trying and learning
with enthusiasm.

I shall try to absorb the tips and advice but accept that without seeing my
code, the help that's offered will be limited. Is there a preferred method
of sharing code as the project I'm working on is large and, I also fear that
members of this community might not be willing to wade through large amounts
of my code as they have their own day jobs.

Any thoughts/instructions will be gratefully received.

I agree it is hard to say without seeing the whole code. Some comments
though:

1. Why are you using a Range like that? Is it really needed? Setting a
range object for each cell...yikes.

2. Perhaps use a For Each...

Function CellText(oCell As Cell)
CellText = Left(oCell.Range.Text, _
Len(oCell.Range.Text) - 2)
End Function

Sub TableStuff()
Dim oTable As Table
Dim oCell As Cell

Set oTable = ActiveDocument.Tables(1)
For Each oCell In oTable.Rows(2).Range.Cells
MsgBox CellText(oCell)
Next
End Sub

Note that I used a slightly different version of Greg's cell text function.
You can pass in either the string of the cell (Greg's version), or in my
version the cell itself.

Greg's version:

Function CellText2(strIn As String)
CellText2 = Left(strIn, Len(strIn) - 2)
End Function

Sub TableStuff()
Dim oTable As Table
Dim oCell As Cell

Set oTable = ActiveDocument.Tables(1)
For Each oCell In oTable.Rows(2).Range.Cells
MsgBox CellText2(oCell.Range.Text)
Next
End Sub


Gerry

Hard to say without seeing your entire code.

I haven't had any formal training and the little I know has been gained from
trail and error, some of it painful ;-), and spoon feeding by many of the
Titans of VBA posting here.

I can pass on that minimizing what process has to figure out and have often
it must figure it out can help. For example:

For i = 1 to ActiveDocument.Tables(1).Rows.Count
'Do this
Next i

If the table has 5 rows then that is being determined each time the For
statement runs.

Better (IMHO) to do something like

lngRowCount = ActiveDocument.Tables(1).Rows.Count

For i = 1 to lngRowCount
'Do this
Next i

That only has to be figured once.

As a demo I created a 4 col 600 row table fille with text (just "Cell and a
number) and ran the following code. The time to run was 24 seconds and 15
seconds. Pretty good gain in efficiency ;-)

Do you need to use the Set statement?

Option Explicit
Sub Demo()
Dim t As Single
Dim i As Long
t = Timer
FillArray ActiveDocument.Tables(1)
t = Timer - t
MsgBox "The macro took " & t & " seconds."
t = Timer
FillArrayFaster ActiveDocument.Tables(1)
t = Timer - t
MsgBox "The macro took " & t & " seconds."
End Sub
Sub FillArray(ByRef oTable As Table)
Dim arrReplace() As String
Dim i As Long, j As Long
'Dimension array to hold table row and column data
ReDim arrReplace(oTable.Rows.Count - 1, oTable.Columns.Count - 1)
'Load data from rows
For i = 0 To oTable.Rows.Count - 1
For j = 0 To oTable.Columns.Count - 1
'Use function to strip end of cell marker and load only text
arrReplace(i, j) = fcnCellText(oTable.Cell(i + 1, j + 1).Range.Text)
Next
Next
End Sub
Sub FillArrayFaster(ByRef oTable As Table)
Dim arrReplace() As String
Dim i As Long, j As Long, oRowCount As Long, oColCount As Long
oRowCount = oTable.Rows.Count: oColCount = oTable.Columns.Count
'Dimension array to hold table row and column data
ReDim arrReplace(oRowCount - 1, oColCount - 1)
'Load data from rows
For i = 0 To oRowCount - 1
For j = 0 To oColCount - 1
'Use function to strip end of cell marker and load only text
arrReplace(i, j) = fcnCellText(oTable.Cell(i + 1, j + 1).Range.Text)
Next
Next
End Sub
Function fcnCellText(ByRef pStr As String)
fcnCellText = Left(pStr, Len(pStr) - 2)
End Function

Hi all,

[quoted text clipped - 19 lines]

Many thanks for looking.

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.aspx/word-programming/201002/1

.

 

[spunkymuffmonkey]

Hi again,

I just thought I would let you know that, having had a chance to refine my
code as per our discussions, my macro is running much more smoothly.

Thanks for all your time and efforts.

Alex

A million thanks indeed for giving me reason to continue trying and learning
with enthusiasm.

I shall try to absorb the tips and advice but accept that without seeing my
code, the help that's offered will be limited. Is there a preferred method
of sharing code as the project I'm working on is large and, I also fear that
members of this community might not be willing to wade through large amounts
of my code as they have their own day jobs.

Any thoughts/instructions will be gratefully received.

I agree it is hard to say without seeing the whole code. Some comments
though:

1. Why are you using a Range like that? Is it really needed? Setting a
range object for each cell...yikes.

2. Perhaps use a For Each...

Function CellText(oCell As Cell)
CellText = Left(oCell.Range.Text, _
Len(oCell.Range.Text) - 2)
End Function

Sub TableStuff()
Dim oTable As Table
Dim oCell As Cell

Set oTable = ActiveDocument.Tables(1)
For Each oCell In oTable.Rows(2).Range.Cells
MsgBox CellText(oCell)
Next
End Sub

Note that I used a slightly different version of Greg's cell text function.
You can pass in either the string of the cell (Greg's version), or in my
version the cell itself.

Greg's version:

Function CellText2(strIn As String)
CellText2 = Left(strIn, Len(strIn) - 2)
End Function

Sub TableStuff()
Dim oTable As Table
Dim oCell As Cell

Set oTable = ActiveDocument.Tables(1)
For Each oCell In oTable.Rows(2).Range.Cells
MsgBox CellText2(oCell.Range.Text)
Next
End Sub


Gerry

Hard to say without seeing your entire code.

I haven't had any formal training and the little I know has been gained from
trail and error, some of it painful ;-), and spoon feeding by many of the
Titans of VBA posting here.

I can pass on that minimizing what process has to figure out and have often
it must figure it out can help. For example:

For i = 1 to ActiveDocument.Tables(1).Rows.Count
'Do this
Next i

If the table has 5 rows then that is being determined each time the For
statement runs.

Better (IMHO) to do something like

lngRowCount = ActiveDocument.Tables(1).Rows.Count

For i = 1 to lngRowCount
'Do this
Next i

That only has to be figured once.

As a demo I created a 4 col 600 row table fille with text (just "Cell and a
number) and ran the following code. The time to run was 24 seconds and 15
seconds. Pretty good gain in efficiency ;-)

Do you need to use the Set statement?

Option Explicit
Sub Demo()
Dim t As Single
Dim i As Long
t = Timer
FillArray ActiveDocument.Tables(1)
t = Timer - t
MsgBox "The macro took " & t & " seconds."
t = Timer
FillArrayFaster ActiveDocument.Tables(1)
t = Timer - t
MsgBox "The macro took " & t & " seconds."
End Sub
Sub FillArray(ByRef oTable As Table)
Dim arrReplace() As String
Dim i As Long, j As Long
'Dimension array to hold table row and column data
ReDim arrReplace(oTable.Rows.Count - 1, oTable.Columns.Count - 1)
'Load data from rows
For i = 0 To oTable.Rows.Count - 1
For j = 0 To oTable.Columns.Count - 1
'Use function to strip end of cell marker and load only text
arrReplace(i, j) = fcnCellText(oTable.Cell(i + 1, j + 1).Range.Text)
Next
Next
End Sub
Sub FillArrayFaster(ByRef oTable As Table)
Dim arrReplace() As String
Dim i As Long, j As Long, oRowCount As Long, oColCount As Long
oRowCount = oTable.Rows.Count: oColCount = oTable.Columns.Count
'Dimension array to hold table row and column data
ReDim arrReplace(oRowCount - 1, oColCount - 1)
'Load data from rows
For i = 0 To oRowCount - 1
For j = 0 To oColCount - 1
'Use function to strip end of cell marker and load only text
arrReplace(i, j) = fcnCellText(oTable.Cell(i + 1, j + 1).Range.Text)
Next
Next
End Sub
Function fcnCellText(ByRef pStr As String)
fcnCellText = Left(pStr, Len(pStr) - 2)
End Function

Hi all,

[quoted text clipped - 19 lines]

Many thanks for looking.

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.aspx/word-programming/201002/1

.