Increase macro speed?

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

--
Valeria

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.

--
Regards,
Tom Ogilvy



"Valeria" <[email protected]> wrote in message
news:[email protected]...
> 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
>
> --
> Valeria

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


Valeria wrote:
> 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
>

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" wrote:

> 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.
>
> --
> Regards,
> Tom Ogilvy
>
>
>
> "Valeria" <[email protected]> wrote in message
> news:[email protected]...
> > 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
> >
> > --
> > Valeria
>
>
>

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.

--
Regards,
Tom Ogilvy


"Valeria" <[email protected]> wrote in message
news:[email protected]...
> 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" wrote:
>
> > 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.
> >
> > --
> > Regards,
> > Tom Ogilvy
> >
> >
> >
> > "Valeria" <[email protected]> wrote in message
> > news:[email protected]...
> > > 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
> > >
> > > --
> > > Valeria
> >
> >
> >

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


On Fri, 11 Feb 2005 04:21:02 -0800, "Valeria"
<[email protected]> wrote:

>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

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.

On Fri, 11 Feb 2005 20:46:25 +0800, Ajtb <[email protected]> wrote:

>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
>
>
>Valeria wrote:
>> 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
>>

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

"Tom Ogilvy" wrote:

> 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.
>
> --
> Regards,
> Tom Ogilvy
>
>
> "Valeria" <[email protected]> wrote in message
> news:[email protected]...
> > 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" wrote:
> >
> > > 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.
> > >
> > > --
> > > Regards,
> > > Tom Ogilvy
> > >
> > >
> > >
> > > "Valeria" <[email protected]> wrote in message
> > > news:[email protected]...
> > > > 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
> > > >
> > > > --
> > > > Valeria
> > >
> > >
> > >
>
>
>