Slow Code Any Suggestions

[jgoulart]

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 ]

[Barrie Davidson]

Does your database have a header row (i.e., does the first row contain headers and not data)?

[Steve Hartman]

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?

[jgoulart]

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.

[jgoulart]

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

[Barrie Davidson]

John, try this code (it should be faster because it's not looping through all the cells):

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 ]