Link to home
Get AccessLog in
Avatar of Louise Owens
Louise Owens

asked on

How to rework VBA script to not use select

I'm using the below code where I find a value in a column (TblName) the if the value is not found I run the following code. I'm running this in a loop of about 48000 rows. ITs taking about an hour to run. I think the problem is the code here and all the selects. I don't know how to rewrite to speed the code up. Can anyone look and see if there is something I can do here

Sub sbAddSchemaNme()
    Dim FindSchemaNme As Range
    Dim FindTblNme As Range
    Dim FindColNme As Range

    'Turn updating off
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    'set worksheets
    SchemaNme = Worksheets("DbList").Range("C2")
    TblNme = Worksheets("DbList").Range("D2")

    'set locations for lookup values
    Set FindSchemaNme = Worksheets("Scope List").Range("A:A").Find(SchemaNme, LookIn:=xlValues, LookAt:=xlWhole)
    Set FindTblNme = Worksheets("Scope List").Range("A4:XFD4").Find(TblNme, LookIn:=xlValues, LookAt:=xlWhole)

    'Turn updating off
    Application.ScreenUpdating = False
    Sheets("Scope List").Activate

    'set ranges for drop down box lookup values
    If Not FindSchemaNme Is Nothing Then
    Else
        ActiveSheet.Range("A4:A100").Find("").Select
        ActiveCell = SchemaNme
        ActiveSheet.Range("A4:XFD4").Find("").Select
        ActiveCell = SchemaNme
        ActiveSheet.Range("A5:XFD5").Find("").Select
        ActiveCell = "Choose?"

    End If

    'activate worksheets
    Sheets("DbList").Activate

    'Turn updating on
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True

End Sub
Sub sbAddTblNme()
    Dim FindSchemaNme As Range
    Dim FindTblNme As Range
    Dim FindColNme As Range

    'Turn updating off
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    
    'set worksheets
    SchemaNme = Worksheets("DbList").Range("C2")
    TblNme = Worksheets("DbList").Range("D2")

    'activate worksheet
    Sheets("DbList").Select

    'set locations for lookup values
    Set FindSchemaNme = Worksheets("Scope List").Range("A:A").Find(SchemaNme, LookIn:=xlValues, LookAt:=xlWhole)
    Set FindTblNme = Worksheets("Scope List").Range("A4:XFD4").Find(TblNme, LookIn:=xlValues, LookAt:=xlWhole)

    'Turn updating off
    Application.ScreenUpdating = False

    'activate worksheet
    Sheets("Scope List").Activate

    'set ranges for drop down box lookup values
    If Not FindTblNme Is Nothing Then
    Else

        ActiveSheet.Range("A4:XFD4").Find(SchemaNme).Select
        ActiveCell.End(xlDown).Offset(1, 0).Select
        ActiveCell = TblNme
        ActiveSheet.Range("A5:XFD5").Find("").Select
        ActiveSheet.Range("A4:XFD4").Find("").Select
        ActiveCell = TblNme
        ActiveSheet.Range("A5:XFD5").Find("").Select
        ActiveCell = "Choose?"

    End If
    Sheets("DbList").Activate

    'Turn updating off
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True

End Sub
Sub sbAddColNme()
    Dim FindSchemaNme As Range
    Dim FindTblNme As Range
    Dim FindColNme As Range

    'Turn updating off
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    'set worksheets

    TblNme = Worksheets("DbList").Range("D2")
    ColNme = Worksheets("DbList").Range("E2")

    'set locations for lookup values
    Set FindTblNme = Worksheets("Scope List").Range("A4:XFD4").Find(TblNme, LookIn:=xlValues, LookAt:=xlWhole)
    Set FindColNme = Worksheets("Scope List").Range("A4:XFD4").Find(ColNme, LookIn:=xlValues, LookAt:=xlWhole)

    'Turn updating off
    Application.ScreenUpdating = False
    Sheets("Scope List").Activate

    'set ranges for drop down box lookup values
    If Not FindColNme Is Nothing Then
    Else
        ActiveSheet.Range("A4:XFD4").Find(TblNme).Select
        ActiveCell.Offset(1, 0).Select
        ActiveCell = "Choose?"
        ActiveSheet.Range("A4:XFD4").Find(TblNme).Select
        ActiveCell.End(xlDown).Offset(1, 0).Select
        ActiveCell = ColNme

    End If

    'activate worksheet
    Sheets("DbList").Activate

    'Turn updating on
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    
End Sub

Open in new window

Avatar of Louise Owens
Louise Owens

ASKER

Thanks. I resubmitted my questions with your suggestion. Learning curve on how to use this site.
ASKER CERTIFIED SOLUTION
Avatar of Martin Liss
Martin Liss
Flag of United States of America image

Link to home
membership
This content is only available to members.
To access this content, you must be a member of Experts Exchange.
Get Access
SOLUTION
Link to home
membership
This content is only available to members.
To access this content, you must be a member of Experts Exchange.
Get Access
ScreenUpdating is set to True when VBA loses scope and returns control to the worksheet user interface.

I realize that a number of Excel experts disagree with me, including Excel MVP Tom Urtis (who has a webpage on the subject). I don't buy his reasoning. My experience suggests that it is counterproductive to turn screen updating back on when you have a master macro calling subs in a loop--and each of those subs toggles screen updating off and then back on. This situation is quite common when people assemble their code from questions on help forums like Experts Exchange because those questions are almost always focused on a small part of the overall project.

When I am asked to consult on complete workbooks where the macros run slowly, one of the first things I do is to comment out all statements turning screen updating back on. I then address the .Select and .Activate statements like Ms. Owens has requested. Generally, those two steps alone make the code fast enough that nothing more is necessary.

In the event more is needed, I examine the algorithm(s) used by the code and try to make them smarter. Use array transfer into subs (and back) rather than looping through the worksheet a row at a time. Make better guesses when a sub must iterate to converge on a solution.

When all is said and done, my experience is that code can be made to run three orders of magnitude faster.
Neither solution seemed to make the script run faster. It still takes some time. I will someday learn to use array to transfer into subs (and back), but right now I don't have the knowledge to do that in this situation. Definitely a learning process here.
So are you going to post a sample workbook with your complete code?
See if this helps at all.

Sub sbAddSchemaNme()
    Dim FindSchemaNme As Range
    Dim FindTblNme As Range
    Dim FindColNme As Range

    'Turn updating off
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    'set worksheets
    SchemaNme = Worksheets("DbList").Range("C2")
    TblNme = Worksheets("DbList").Range("D2")

    'set locations for lookup values
    Set FindSchemaNme = Worksheets("Scope List").Range("A:A").Find(SchemaNme, LookIn:=xlValues, LookAt:=xlWhole)
    Set FindTblNme = Worksheets("Scope List").Range("A4:XFD4").Find(TblNme, LookIn:=xlValues, LookAt:=xlWhole)

    Sheets("Scope List").Activate

    'set ranges for drop down box lookup values
    If FindSchemaNme Is Nothing Then
        With ActiveSheet
            .Range("A4:A100").Find("") = SchemaNme
            .Range("A4:XFD4").Find("") = SchemaNme
            .Range("A5:XFD5").Find("") = "Choose?"
        End With
    End If

    'activate worksheets
    Sheets("DbList").Activate

    'Turn updating on
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Open in new window

Per the suggestion, I guess it would be easier if I attached a sample of what I'm trying to accomplish and the code.
Data-Transfer-Sample.xlsm
Corrected File if anybody can look to see how I can improve.
Data-Transfer-Sample.xlsm
The most recent attachment shows 0 bytes, so something went wrong with it.

I took out the statements toggling events, alerts and screen updating. The code is still slow.

The next step towards optimization will be to avoid looping through cells in the worksheet. Using array transfer to do it entirely within VBA would be helpful. To take this approach, I'd need a good description of what your macros are supposed to be accomplishing. I think it is possible to drive execution time under a minute.
Hi Experts

I've taken the suggestions provided here on the site, and revised the code and the run time is now about 28 minutes instead of 1 to 1.2  hour to complete.

The code is to do the following:

Run Macro sbUpdateScopeList

1. This macro loops through the worksheet Dblist starting at row 3 and copies each row to Cells A2 B2, C2
2. Then the macro calls the below 3 macros on DBlist Cells A2, B2, C2
             sbAddSchemaNme
             sbAddTblNme
             sbAddColNme

3. The result is worksheet Scope List

There was a suggestion to do an array, instead of looping; however this is above my skillset right now and I don't know how to accomplish.  I'm attaching a copy of the worksheet example for review.

Thanks
Data-Transfer-Sample-3.xlsm