Increase macro speed?

[Guest]

Dear experts,
I have a macro that simply compares dates in 2 databases, and if the dates
are the same, then it cuts the row from the first database and copies it to
the second workbook.
The macro works very quickly at the beginning, but it gets very slow as it
runs (it takes hours to go thorugh 400 rows)!
Is there a way to modify the code to have it working more efficiently?
Many thanks!
Best regards,
Valeria

For i = 1 To Last_Row

If Workbooks(WB1).Worksheets(1).Cells(i, Exp_Date_Column) = Date_Report
Then
Workbooks(WB1).Worksheets(1).Rows(i).Cut
Workbooks(Montly_Report).Worksheets(WS).Rows(k)
Workbooks(WB1).Worksheets(1).Rows(i).Delete
i = i - 1
k = k + 1
NextRow = Application.WorksheetFunction.CountA(Range("A:A"))
Last_Row = NextRow
Application.CutCopyMode = False
End If
Next i

 

[Tom Ogilvy]

Dim rng as Range
Dim i as Long, k as Long
Dim Last_Row as Long
Dim WB1 as String
Dim WS as String
Dim Monthly_Report as String
WB1 = "????"
WS = "????"
Monthly_Report = "?????"
Last_Row = Workbooks(WB1).Worksheets(1) _
.Cells(rows.count,1).End(xlup).Row
k = Workbooks(Montly_Report) _
.Worksheets(WS).Cells(rows.count,1) _
.End(xlup).Row
For i = 1 To Last_Row
With Workbooks(WB1).Worksheets(1)
if .Cells(i,Exp_Date_Column) = Date_Report Then
if rng is nothing then
set rng = .Cells(i,1)
else
set rng = union(rng,.cells(i,1))
end if
End If
End with
Next i
if not rng is nothing then
rng.EntireRow.copy Destination:=
Workbooks(Montly_Report).Worksheets(WS) _
.Cells(k,1)
rng.EntireRow.Delete
End if

Another way would be to apply an autofilter to your data, filtering on the
date of interest. If that isn't fast enough, post back and I will put up
the autofilter method.

 

[Ajtb]

Hi
It is dangerous to redefine a counter variable like i within its own
loop. Your loop would be simpler and may work quicker if you did this:

For i = Last_Row to 1 Step -1
If Workbooks(WB1).Worksheets(1).Cells(i, Exp_Date_Column) =
Date_Report Then
Workbooks(WB1).Worksheets(1).Rows(i).Copy _
Workbooks(Montly_Report).Worksheets(WS).Rows(k)
Workbooks(WB1).Worksheets(1).Rows(i).Delete
k=k+1
end if

Next i

HTH
Andrew Bourke

 

[Guest]

Hi Tom,
I get an error with your code at .union (rng,cells(i,1)) - the Union Method
of the _Global ... has failed.
What does it mean?
Also, I needed to modify the code to include the copying in the loop (so I
have put the "next i" at the end) and also the k definition belongs to the
loop, as the worksheet k refers to adds more and more rows.
Actually, also the Last_Row is changed with the loop, as rows are cut. May I
include this in the loop, too? I have read the othe rpost and looks like it's
not really reccomended.
Many thanks!
Best regards,
Valeria

 

[Tom Ogilvy]

I had a dot before cells in my original code:

set rng = union(rng,.cells(i,1))

You don't show it in the email, so if that is the case, that may be the
problem.

 

[Myrna Larson]

You should be aware that VBA determines the value of Last_Row when the For i
loop first starts. You change it later within the loop. VBA doesn't see that
change. If it was originally 10, the loop will stop when it has executed 10
times, regardless of the new value you assigned to Last_Row. The following
code snippet demonstrates. It will print the numbers 1-3, not 1-10.

N = 3
For i = 1 To N
Debug.Print i
If i = 1 Then N = 10
Next i

 

[Myrna Larson]

Not only that, but changing the value of Last_Row does nothing. If you need to
change i and Last_Row, you should be using a Do/Loop construction.

 

[Guest]

Hi Tom,
I had the dot in my code, still the code was giving me the error. I
restarted my computer, and then finally it worked (no clue why it was not
working before).
Anyway, finally I tested your code, and it works WONDREFULLY! It is simply
genius, it takes me now 20 seconds to do what it was taking before 4 hours.
Many, many thanks, and also to Myrna for the explanations on the For Code.
Best regards,
Valeria