troubleshooting Question

How to rework VBA script to not use select

Avatar of Louise Owens
Louise Owens asked on
Microsoft ExcelVBA
11 Comments2 Solutions65 ViewsLast Modified:
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
ASKER CERTIFIED SOLUTION
Join our community to see this answer!
Unlock 2 Answers and 11 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 2 Answers and 11 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros