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

VBAMicrosoft Excel

Avatar of undefined
Last Comment
Louise Owens

8/22/2022 - Mon
Louise Owens

ASKER
Thanks. I resubmitted my questions with your suggestion. Learning curve on how to use this site.
ASKER CERTIFIED SOLUTION
Martin Liss

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
SOLUTION
Log in to continue reading
Log In
Sign up - Free for 7 days
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
byundt

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.
Louise Owens

ASKER
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.
Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes
byundt

So are you going to post a sample workbook with your complete code?
Martin Liss

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

Louise Owens

ASKER
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
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Louise Owens

ASKER
Corrected File if anybody can look to see how I can improve.
Data-Transfer-Sample.xlsm
byundt

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.
Louise Owens

ASKER
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
Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy