Speed up before/after refresh subs

Question

I have the following VBA subs that run before and after query refresh. However, it's taking quite a while to run through the code (about 20 seconds or so from clicking 'Refresh All' to being able to use the spreadsheet again, more time when there are more lines). I'm fairly new to VBA, so please let me know if you see any areas for improvement!

This is all functional, just slow! :)

Initialization Sub:

Dim X As New query_table

Sub Initialize_It()

    Set X.qt = ThisWorkbook.Sheets("Lines to Check").ListObjects("Table_Query_from_Excel_Queries").QueryTable
    
End Sub

Calling Initialization Sub:

Private Sub Workbook_Open()
    
    'Initialize query_table object
    initialize.Initialize_It

End Sub

Class Module Header:

Public WithEvents qt As QueryTable

Class Module (Before Refresh):

Private Sub qt_BeforeRefresh(Cancel As Boolean)

    Application.EnableEvents = False
    
    'Save everything!
    ActiveWorkbook.Save
    
    'Go to Lines to Check sheet
    Sheets("Lines to Check").Select
    'Clear all filters
    ActiveSheet.AutoFilter.ShowAllData
    
    'Go to Upload Data sheet
    Sheets("Upload Data").Select
    'Clear all filters
    ActiveSheet.AutoFilter.ShowAllData
    'Reset header labels (on Upload Data sheet)
    Range("A1").Value = "# Rows Used:"
    Range("A2").Value = "PO-Line-ISBN"
    Range("B2").Value = "Called"
    Range("C2").Value = "Online"
    Range("D2").Value = "Emailed"
    Range("E2").Value = "ISBN"
    Range("F2").Value = "New Status"
    Range("G2").Value = "PO #"
    Range("H2").Value = "Ln #"
    Range("I2").Value = "Personal Notes"
    
    'Select the Lines to Check sheet and unhide upload columns
    Sheets("Lines to Check").Select
    Columns("AC:AL").EntireColumn.Hidden = False
    'Copy upload data
    Range("Table_Query_from_Excel_Queries[[**FOR UPLOAD** PO-Line-ISBN]:[**FOR UPLOAD** Personal Notes]]").Select
    Selection.Copy
    
    'Paste to Upload Data sheet
    Sheets("Upload Data").Select
    Sheets("Upload Data").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    'Display last row number in cell B1
    Dim rowCount As Long
    rowCount = Sheets("Upload Data").Cells(Rows.Count, 1).End(xlUp).Row
    Range("B1").Value = rowCount
    
    'Go to Lines to Check sheet
    Sheets("Lines to Check").Select
    'Clear manually entered data
    Range("Table_Query_from_Excel_Queries[[Updated Status (Format like P21 Ext Desc)]:[Emailed]]").Select
    Selection.ClearContents
    'Hide upload data columns
    Columns("AC:AL").EntireColumn.Hidden = True
    
    'Go home
    Sheets("Lines to Check").Select
    Range("A14").Select
    Range("A1").Select

    Application.EnableEvents = True
    
End Sub

Class Module (After Refresh):

Private Sub qt_AfterRefresh(ByVal Success As Boolean)

    Application.EnableEvents = False
    
    'Save quotation mark to variable (for less confusing use)
    Dim quoteMark As String
    quoteMark = """"
    
    'Go to the Lines to Check sheet
    Sheets("Lines to Check").Select
    'Fill blank cells with spaces to eliminate text overflow
    For Each i In Range("Table_Query_from_Excel_Queries[[Buyer]:[Updated Status (Format like P21 Ext Desc)]]")
        If i.Value = "" Then
            i.Value = " "
        End If
    Next i
    
    For Each i In Range("Table_Query_from_Excel_Queries[[IM Ext Desc]:[SO Ln '#]]")
        If i.Value = "" Then
            i.Value = " "
        End If
    Next i
    
    'Fill notes column w/ previously entered data
    Range("Table_Query_from_Excel_Queries[Queued to Upload/Notes]").Value = "=XLOOKUP([@[PO-Line-ISBN]],'Upload Data'!$A:$A,'Upload Data'!$I:$I," & quoteMark & quoteMark & ",0,-1) & " & quoteMark & " " & quoteMark & " & XLOOKUP([@[PO-Line-ISBN]],'Upload Data'!$A:$A,'Upload Data'!$F:$F," & quoteMark & quoteMark & ",0,-1)"
    
    'Fill Called column with most recent call dates
    Range("Table_Query_from_Excel_Queries[Called]").Value = "=XLOOKUP([@[PO-Line-ISBN]],'Upload Data'!A:A,'Upload Data'!B:B," & quoteMark & quoteMark & ",0,-1)"
 
    'Fill Online column with most recent online dates
    Range("Table_Query_from_Excel_Queries[Online]").Value = "=XLOOKUP([@[PO-Line-ISBN]],'Upload Data'!A:A,'Upload Data'!C:C," & quoteMark & quoteMark & ",0,-1)"

    'Fill Emailed column with most recent email dates
    Range("Table_Query_from_Excel_Queries[Emailed]").Value = "=XLOOKUP([@[PO-Line-ISBN]],'Upload Data'!A:A,'Upload Data'!D:D," & quoteMark & quoteMark & ",0,-1)"
    
    'Go home
    Range("A13").Select 'Ensures that non-frozen rows are not scrolled all the way to the bottom
    Range("A1").Select 'Goes "home"

    Application.EnableEvents = True
    
End Sub

Answer 1

There are a few things you can do that are very very likely to speed up execution of your code.

I see you are turning Applications.EnableEvents off at the start of your code and then back on and the end. You should do the same for Application.ScreenUpdating and also turn automatic calculation off temporarily.

i.e. do the following for each sub:

Sub your_sub_name()

      Application.EnableEvents = False
      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual

      '... (Your Code)

      Application.EnableEvents = True
      Application.ScreenUpdating = True
      Application.Calculation = xlCalculationAutomatic

End Sub

Note that if application calculation is left as manual it can lead to unexpected behaviour in Excel later, so ideally you should handle errors in your code to make sure the last block always runs, but if you are confident that your code will complete without any errors you can try it out to start with.

Also, you do not need to Select and then use ActiveSheet every time you want to do something to a sheet. It is cleaner to use With statements. For example you can replace:

'Go to Upload Data sheet
Sheets("Upload Data").Select
'Clear all filters
ActiveSheet.AutoFilter.ShowAllData
'Reset header labels (on Upload Data sheet)
Range("A1").Value = "# Rows Used:"
Range("A2").Value = "PO-Line-ISBN"
Range("B2").Value = "Called"
Range("C2").Value = "Online"
Range("D2").Value = "Emailed"
Range("E2").Value = "ISBN"
Range("F2").Value = "New Status"
Range("G2").Value = "PO #"
Range("H2").Value = "Ln #"
Range("I2").Value = "Personal Notes"

with:

With Sheets("Upload Data")
    'Clear all filters
    .AutoFilter.ShowAllData
    'Reset header labels
    .Range("A1").Value = "# Rows Used:"
    .Range("A2").Value = "PO-Line-ISBN"
    .Range("B2").Value = "Called"
    .Range("C2").Value = "Online"
    .Range("D2").Value = "Emailed"
    .Range("E2").Value = "ISBY"
    .Range("F2").Value = "New Status"
    .Range("G2").Value = "PO #"
    .Range("H2").Value = "Ln #"
    .Range("I2").Value = "Personal Notes"
End With

I am not sure whether this will have a noticeable effect on running time for your program, but it will definitely make your code more concise and readable and may help you to spot places where you can make it more efficient, so is definitely worth doing.

This site has some other tips for optimising VBA code that you may want to check out: http://www.eident.co.uk/2016/03/top-ten-tips-to-speed-up-your-vba-code/

Answer 2

You don't need to hide/unhide columns to access data. It's ok while testing but takes time.

There are a few more time consumig automations that can be disabled for the time of operation, see: Changing the formatting of sheets.

Minor impovements can be achieved with applying array operation (for horizontal contiguous ranges only) like

Range("A2:I2").Value = Array("PO-Line-ISBN", "Called", "Online", ...)

You can replace If i.Value = "" with If LenB(i.Value) = 0 for it checks a single byte in the string header instead of invoking a fairly complex string comparision method.

Try to address ranges directly. Use Sheets(whatever).Range(whatever).Copy instead of Sheets(whatever).Select / Range(whatever).Copy. The later method activates the selected sheet that takes time.