Code optimization needed (1 Viewer)

[bob_maul]

The following code is used to essentially export queries to excel with some light formatting. There's about a 50/50 mix, where some of these queries are exported to an existing excel template, and the rest go to a fresh workbook. There is certainly room for optimization in the code for the later half, but would I just be better off using a DoCmd.Transferspreadsheet for those instead? For reference, this gets referenced a few hundred times during month end reporting, so not sure if the optimization would make a dent in the processing time, or if I should spend my time focusing on the bulk queries.

Option Compare Database
Option Explicit


'Exporting DAO to Excel with some basic formatting. Will overwrite if file already exists to preserve any data connections
'Sheet names are not case sensitive, and support spacing
'

Public Sub OutXL_Mult(strQueryName As String, strExportPath As String, strSheetName As String)

    Const strcCellAddress As String = "A1"
    Dim objExcel As Object
    Dim objWB As Object
    Dim objWS As Object
    Dim objRNG As Object
    Dim SaveArray() As String
    Dim SaveFormat As Long
    Dim objDB As DAO.Database
    Dim objRS As DAO.Recordset
    Dim objQry As DAO.QueryDef
    Dim i As Integer
    Dim prm As Variant
    Dim Exists As Boolean
        
    Set objDB = CurrentDb
    Set objQry = objDB.QueryDefs(strQueryName) 
    
    'pulls dates from form
    For Each prm In objQry.Parameters
        prm.Value = Eval(prm.Name)
    Next prm

    Set objRS = objQry.OpenRecordset(Options:=dbSeeChanges)
    
    '***Open and define Excel objects***
    Set objExcel = CreateObject("Excel.Application")
    
    'Check to see if WB exists
    If Dir(strExportPath) = "" Then
         Set objWB = objExcel.Workbooks.Add
    Else
         Set objWB = objExcel.Workbooks.Add(strExportPath)
    End If

    'Check to see if WS exists
    For i = 1 To objWB.Worksheets.Count
        If objWB.Worksheets(i).Name = strSheetName Then
            Exists = True
        End If
    Next i

    If Not Exists Then
        objWB.Worksheets.Add.Name = strSheetName
    End If
 
 
    Set objWS = objWB.Worksheets(strSheetName)
    Set objRNG = objWS.Range(strcCellAddress)
    
    'Calling data in from recored set
    'Clear sheet of current data
    objWS.UsedRange.Clear
    
    'Headers
    For i = 1 To objRS.Fields.Count
        objWS.Cells(1, i).Value = objRS.Fields(i - 1).Name
    Next i
    
    'Recordset
    objWS.Cells(2, 1).CopyFromRecordset objRS
    
    '***Formatting***
    With objWS
        .Cells.Font.Name = "Calbri"
        .Range(strcCellAddress, objWS.Range(strcCellAddress).End(-4161)).Interior.ColorIndex = 15
    End With

    objWS.Cells.EntireColumn.AutoFit

    'Version Check
    SaveArray() = Split(strExportPath, ".")
    
    If SaveArray(1) = "xls" Then
        SaveFormat = 56
    Else
        SaveFormat = 51
    End If
        
    'Close and release
    objExcel.DisplayAlerts = False
    objWB.RefreshAll 'For pivot table updates
    objWB.SaveAs FileName:=strExportPath, FileFormat:=SaveFormat, ReadOnlyRecommended:=False
    objWB.Close
    objExcel.DisplayAlerts = True

    Set objRNG = Nothing
    Set objWS = Nothing
    Set objWB = Nothing
    objExcel.Quit
    Set objExcel = Nothing
    
    Set objRS = Nothing

End Sub

 

[Pat Hartman]

If you want to experiment, it is easy enough. Add some variables so you can store start and finish times to allow you to calculate elapsed time. Print the elapsed time with a description at the end of each section of code.

In general, queries and intrinsic Access Methods such as "Transfer" would be faster than anything done with a VBA code loop.

If the formatting isn't cell by cell. I would use TransferSpreadsheet then open the workbook and select the columns or rows and apply the formatting that way.

 

[NoLongerSet]

You might also want to turn off ScreenUpdating in Excel. I'm not sure whether this boosts performance if the Excel Application itself is not visible, but it would be easy enough to test it by adding the code below and seeing if it improves your run times.

Set objExcel = CreateObject("Excel.Application")
objExcel.ScreenUpdating = False

'Do all of your processing'

objExcel.ScreenUpdating = True

This would be a good thing to try after you put in some profiling (i.e., timing) code as @Pat Hartman suggested.