Issue with code execution -- it is very slow

[robs3131]

Hi all,

I have a major issue right now with the time it is taking for two queries to
execute. This is actually realated to an issue I posted a couple of days ago
("Issue with refreshing pivot tables in my code" posted on 6/4/07).
Regarding the more recent issue, the code below takes over 10 minutes (at
least) to execute -- I always just kill the query after a period of time. It
doesn't make sense to me as to why it would take this long.

This is very concerning because the end product will have significantly more
data than what I am using for testing (there are 5997 records on the "Member
ID Report Master" sheet and only 3 records on the "Payment Sales Master"
sheet currently).

Does anyone have any idea as to why it would take Excel so long to execute
this query??? Might it have something to do with the fact that I had pivot
tables originally in this file that I was refreshing via the code? FYI - I
decided to get rid of the pivot tables (they are now deleted from the file)
and essentially replicate the functionality of the pivot table through the
code with the thought that the time to execute the query would decrease
signficantly by not using pivot tables. I've found that this has not been
the case... for more info on my issue with the pivot tables, please see my
post titled "Issue with refreshing pivot tables in my code" posted on 6/4/07
-- FYI -- I have not received a response to that post).


Sub opentransids()

Dim uniqueidsopen As Range
Dim F 'individual record within "uniqueidsopen" range
Dim payclosed As Range
Dim G 'individual record within "payclosed" range
Dim x 'variable to determine how many rows down to input uniqueidsopen
Dim c 'variable to determine whether or not a uniqueidsopen is also within
opentrans

With Sheets("Unique Member IDs")
If Len(.Range("A3")) <> 0 Then
Set uniqueidsopen = .Range("A2", .Range("A2").End(xlDown))
Else
Set uniqueidsopen = .Range("A2")
End If
End With

With Sheets("Payment Sales Master")
If Len(.Range("H3")) <> 0 Then
Set payclosed = .Range("H2", .Range("H2").End(xlDown))
Else
Set payclosed = .Range("H2")
End If
End With

x = 1
For Each F In uniqueidsopen
c = 0
For Each G In payclosed
If F = G Then
c = c + 1
Else
End If
Next

If c = 0 Then
With Sheets("Open Transactions")
.Range("D1").Offset(x, 0).value = F
x = x + 1
End With
Else
End If
Next

End Sub



Thanks!

 

[PCLIVE]

Try adding:

Application.ScreenUpdating = False 'to the top of your code
Application.ScreenUpdating = True 'to the bottom of your code

HTH,
Paul

 

[RB Smissaert]

Not sure I got the logic right, but try this:

Sub opentransids()

Dim uniqueidsopen 'As Range
Dim payclosed 'As Range
Dim F As Long 'individual record within "uniqueidsopen" range
Dim G As Long 'individual record within "payclosed" range
Dim x As Long 'variable to determine how many rows down to input
uniqueidsopen
Dim c As Long 'variable to determine whether or not a uniqueidsopen is
also within opentrans

Application.ScreenUpdating = False

x = 1

With Sheets("Unique Member IDs")

If Len(.Range("A3")) <> 0 Then

uniqueidsopen = .Range("A2", .Range("A2").End(xlDown))

With Sheets("Payment Sales Master")

If Len(.Range("H3")) <> 0 Then

payclosed = .Range("H2", .Range("H2").End(xlDown))

For F = 1 To UBound(uniqueidsopen)
For G = 1 To UBound(payclosed)
If uniqueidsopen(F, 1) = payclosed(G, 1) Then
c = c + 1
Exit For
End If
Next

If c = 0 Then
With Sheets("Open Transactions")
.Range("D1").Offset(x, 0).Value = uniqueidsopen(F, 1)
x = x + 1
End With
End If
Next

Else

payclosed = .Range("H2")

For F = 1 To UBound(uniqueidsopen)
If uniqueidsopen(F, 1) = payclosed Then
c = c + 1
Exit For
End If

If c = 0 Then
With Sheets("Open Transactions")
.Range("D1").Offset(x, 0).Value = uniqueidsopen(F, 1)
x = x + 1
End With
End If
Next

End If
End With
Else

uniqueidsopen = .Range("A2")

With Sheets("Payment Sales Master")

If Len(.Range("H3")) <> 0 Then

payclosed = .Range("H2", .Range("H2").End(xlDown))
For G = 1 To UBound(payclosed)
If uniqueidsopen = payclosed(G, 1) Then
c = c + 1
Exit For
End If
Next

If c = 0 Then
With Sheets("Open Transactions")
.Range("D1").Offset(x, 0).Value = uniqueidsopen
x = x + 1
End With
End If

Else
payclosed = .Range("H2")
If uniqueidsopen <> payclosed Then
.Range("D1").Offset(x, 0).Value = uniqueidsopen
End If
End If
End With
End If
End With

Application.ScreenUpdating = True

End Sub

There are 3 changes:
Work on arrays rather than ranges.
Early exit from loops.
Application.ScreenUpdating = False

If it doesn't work then you will have to fiddle about, but hopefully you
will get the idea.
Depending on the data this could speed it up a lot.


RBS

 

[RB Smissaert]

I left one c = 0 out. It should be:

x = 1

With Sheets("Unique Member IDs")

If Len(.Range("A3")) <> 0 Then

uniqueidsopen = .Range("A2", .Range("A2").End(xlDown))

With Sheets("Payment Sales Master")

If Len(.Range("H3")) <> 0 Then

payclosed = .Range("H2", .Range("H2").End(xlDown))

For F = 1 To UBound(uniqueidsopen)
c = 0

etc.


RBS

 

[robs3131]

Thanks for the input all. Actually what I've done is I tried just creating a
whole new file from scratch - this worked! Which is good and bad news.
Literally I kept all of the same code and the same sheets of data within the
spreadsheet -- the code now executes in seconds. I don't understand why it
takes 10 minutes plus in the other file...but like I said, I'm guessing it
may have something to do with the fact that I did have pivot tables
originally in the older file and that may have caused some issue (when the
10+ minute query was running, the sheet it was putting data into would first
say "Calculating cells" in the bottom left corner of Excel with a percentage
next to this text that would slowly increase up to 100%....I'm thinking that
this started when I had pivot tables -- the updating of cells -- and
continued to exist in the file after I removed the pivot tables...just a
guess).

What I've learned is that when this problem comes up, I should first try to
start a new file from scratch and past the same code and sheets into the new
file and see if that eliminates the problem.

Thanks,

 

[RB Smissaert]

Download the free VBA Code Cleaner:
http://www.appspro.com/Utilities/CodeCleaner.htm
This will do the same as you did there, but automatically.
If you program in Excel a lot then it is worth to invest a very modest sum
in
Andrew Baker's Workbook Rebuilder, which does the same but better.

Still worth it to try the code I posted as it will make it even faster.

RBS

Thanks for the input all. Actually what I've done is I tried just
creating a
whole new file from scratch - this worked! Which is good and bad news.
Literally I kept all of the same code and the same sheets of data within
the
spreadsheet -- the code now executes in seconds. I don't understand why
it
takes 10 minutes plus in the other file...but like I said, I'm guessing it
may have something to do with the fact that I did have pivot tables
originally in the older file and that may have caused some issue (when the
10+ minute query was running, the sheet it was putting data into would
first
say "Calculating cells" in the bottom left corner of Excel with a
percentage
next to this text that would slowly increase up to 100%....I'm thinking
that
this started when I had pivot tables -- the updating of cells -- and
continued to exist in the file after I removed the pivot tables...just a
guess).

What I've learned is that when this problem comes up, I should first try
to
start a new file from scratch and past the same code and sheets into the
new
file and see if that eliminates the problem.

Thanks,

 

[robs3131]

Thanks so much RBS!
--
Robert

Download the free VBA Code Cleaner:
http://www.appspro.com/Utilities/CodeCleaner.htm
This will do the same as you did there, but automatically.
If you program in Excel a lot then it is worth to invest a very modest sum
in
Andrew Baker's Workbook Rebuilder, which does the same but better.

Still worth it to try the code I posted as it will make it even faster.

RBS

 

[RB Smissaert]

No trouble. Did you try the posted code?

RBS

Thanks so much RBS!

 

[robs3131]

Hi RBS,

Sorry for the late reply, but yes, I downloaded the free code cleaner and
have used it. It hasn't made a noticeable difference as of yet, probably
because I had already copied my project to another file, which seemed to
resolve the issue, before running the code cleaner. But I will use the code
cleaner when I run into this issue going forward.

Thanks,