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
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