Error Checking in Excel
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 6 of 6

Thread: Slow Code Any Suggestions

  1. #1
    Board Regular
    Join Date
    Feb 2002
    Location
    John G
    Posts
    62
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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 ]

  2. #2
    MrExcel MVP Barrie Davidson's Avatar
    Join Date
    Feb 2002
    Location
    Winnipeg
    Posts
    2,330
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

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

    "You're only given a little spark of madness. You mustn't lose it." - Robin Williams

  3. #3
    Board Regular Steve Hartman's Avatar
    Join Date
    Feb 2002
    Location
    Houston,Texas
    Posts
    417
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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?

  4. #4
    Board Regular
    Join Date
    Feb 2002
    Location
    John G
    Posts
    62
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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.

  5. #5
    Board Regular
    Join Date
    Feb 2002
    Location
    John G
    Posts
    62
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  6. #6
    MrExcel MVP Barrie Davidson's Avatar
    Join Date
    Feb 2002
    Location
    Winnipeg
    Posts
    2,330
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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 ]

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •