Slow Code Any Suggestions

jgoulart

Board Regular
Joined
Feb 16, 2002
Messages
62
The following code runs extremely slow and I'm sure that someone here will be able to tell me what I'm doing wrong, or something that I'm not doing as efficiently as possible. This is the code of a command button on a userform that accepts 2 dates breport.sdate and breport.edate. It opens a different excel file that has approximately 1000 rows and 50 filled columns. It sequentially goes through the rows on a date column and compares if it compares within the range then it will copy about 7 or so cells on that row to a different sheet. It took about 1 1/2 minutes to process 137 records. I know that my code probably has lots of problems but hopefully someone will give me an idea of how to speed it up. Here is the code:

Dim rCtr
Dim x
Dim j
Dim wb1 As String
Dim wb2 As String
Dim stdate As Date
Dim endate As Date
Dim fname As String
Dim path As String

Application.ScreenUpdating = False
stdate = breport.sdate
endate = breport.edate
wb1 = ActiveWorkbook.name
path = "c:HInv_data"
fname = "HIdbase.xls"

'test date inputs to see if they are dates
If IsDate(stdate) = False Then
MsgBox "Starting date must be a date in mm/dd/yy format"
Exit Sub
End If
If IsDate(endate) = False Then
MsgBox "Ending date must be a date in mm/dd/yy format"
Exit Sub
End If
'open database file
Application.DisplayAlerts = False
Workbooks.Open Filename:=path & fname
wb2 = ActiveWorkbook.name

'count rows of database
rCtr = Workbooks(wb2).Sheets("database").UsedRange.Rows.Count
Workbooks(wb1).Sheets("Report").Activate
j = 10
For x = 2 To rCtr
'strip data if between dates
If Workbooks(wb2).Sheets("database").Cells(x, 10) >= stdate And _
Workbooks(wb2).Sheets("database").Cells(x, 10)<= endate Then
Workbooks(wb1).Sheets("Report").Cells(j, 1).Value = Workbooks(wb2).Sheets("database").Cells(x, 1)
Workbooks(wb1).Sheets("Report").Cells(j, 2).Value = Workbooks(wb2).Sheets("database").Cells(x, 2)
Workbooks(wb1).Sheets("Report").Cells(j, 3).Value = Workbooks(wb2).Sheets("database").Cells(x, 9)
Workbooks(wb1).Sheets("Report").Cells(j, 4).Value = Workbooks(wb2).Sheets("database").Cells(x, 10)
Workbooks(wb1).Sheets("Report").Cells(j, 5).Value = Workbooks(wb2).Sheets("database").Cells(x, 11)
Workbooks(wb1).Sheets("Report").Cells(j, 6).Value = Workbooks(wb2).Sheets("database").Cells(x, 12)
Workbooks(wb1).Sheets("Report").Cells(j, 7).Value = Workbooks(wb2).Sheets("database").Cells(x, 13)
Workbooks(wb1).Sheets("Report").Cells(j, 8).Value = Workbooks(wb2).Sheets("database").Cells(x, 14)
Workbooks(wb1).Sheets("Report").Cells(j, 9).Value = Workbooks(wb2).Sheets("database").Cells(x, 15)
j = j + 1
End If
Next x
This message was edited by Juan Pablo G. on 2002-02-19 20:38
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Is this all the code? Isee you turned screen updating off but didn't turn it back on. Could it possibly be that the code is running just fine but only appears to be slow since the screen never updates?
 
Upvote 0
Yes, my database file has a header and I start stripping at row 2.

Yes, I see that I have turned off screen updating but I have put a stop in the code right after the code that I posted and most of my tests I wasn't patient enough to wait till it got to the stop I had to control break and look at what line I was on with the J var in the code.
 
Upvote 0
OOPS! I just ran the program on another computer and it ran a lot faster. I guess I have a problem with the pc I was using. Sorry for the false alarm. Thanks for you thoughts, input and help

John
 
Upvote 0
John, try this code (it should be faster because it's not looping through all the cells):
Code:
Dim rCtr
Dim x
Dim j
Dim wb1 As String
Dim wb2 As String
Dim stdate As Date
Dim endate As Date
Dim fname As String
Dim path As String

Application.ScreenUpdating = False
stdate = breport.sdate
endate = breport.edate
wb1 = ActiveWorkbook.Name
path = "c:HInv_data"
fname = "HIdbase.xls"

'test date inputs to see if they are dates
If IsDate(stdate) = False Then
MsgBox "Starting date must be a date in mm/dd/yy format"
Exit Sub
End If
If IsDate(endate) = False Then
MsgBox "Ending date must be a date in mm/dd/yy format"
Exit Sub
End If
'open database file
Application.DisplayAlerts = False
Workbooks.Open FileName:=path & fname
wb2 = ActiveWorkbook.Name

rCtr = Workbooks(wb2).Sheets("database").UsedRange.Rows.Count
Range(Cells(1, 1), Cells(rCtr, Range("A1").End(xlToRight).Column)).Select
Selection.AutoFilter Field:=10, Criteria1:=">=" & stdate, Operator:=xlAnd _
    , Criteria2:="<=" & endate
Range("A2:B" & rCtr & ",I2:O" & rCtr).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Workbooks(wb1).Sheets("Report").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
Workbooks(wb2).Activate
Range(Cells(1, 1), Cells(rCtr, Range("A1").End(xlToRight).Column)).AutoFilter
Range("A1").Select
Workbooks(wb1).Activate

_________________

Barrie Davidson
My Excel Web Page
This message was edited by Barrie Davidson on 2002-02-19 18:11
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,202
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top