We help IT Professionals succeed at work.

How to rework VBA script to not use select

Louise Owens
Louise Owens asked
on
58 Views
Last Modified: 2020-09-29
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

Comment
Watch Question

Author

Commented:
Thanks. I resubmitted my questions with your suggestion. Learning curve on how to use this site.
Social distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION
byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION
byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
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.

Author

Commented:
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.
byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
So are you going to post a sample workbook with your complete code?
Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

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

Author

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

Author

Commented:
Corrected File if anybody can look to see how I can improve.
Data-Transfer-Sample.xlsm
byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
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.

Author

Commented:
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
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.