Export to Excel - Multiple Tabs - Too Slow

[Johnny12]

I have tables I export to excel using a form with a button and VBA on the event procedure. When I first built it, it took at most a minute or two to run, but since then the boss has requested lots of things to be added. It went from a single tab with maybe 15 columns to whatever count AL is. And it went from one tab to 4 tabs. The record count has remained the same. The import of the source data and building of the tables used for the reports is separated from the export. In all, it takes less than 30 seconds to import and build the tables. Sadly, the few minutes to run the export has jumped to almost half an hour for it to finish running. If I reduce the record count to say 10 records vice the 3000, run time is considerably improved. I need to find ways to optimize the report while running all records.



1) Are there any "common" mistakes which prolong run time I should consider? Links to articles discussing would be cool. (note-I always run a compact and repair prior to running the export)

2) All of the tabs export the data in the exact same format (except tab name), the only difference being the table it pulls from. For example, the first tab is the full inventory listing (300 records), the 2nd is only Bulk gasses (maybe 20 records), 3rd is non-demand excess (maybe 400 records) and so on. I felt since there are multiple filters to get from, for example, 'All Inventory' to only 'non-demand based gasses with potential sales to another company', it would just be easier creating a table for each tab vice filters in the VBA itself. So the code for each tab is exactly the same, only difference is the table it pulls from. Is there a way to copy formatting from Tab to Tab so I do not need to repeat it 4 times?

3) So the final Excel report is formatted properly, I do have to set the format for every column individually. Some columns may be currency format, others date, others just general but justified right or left. A small example of this which may add to the problem, I set a WrapText to true for every column individually. I could probably set that for the document just once right? Just not sure how. Or, I have lots of columns with the exact same format, but are not continuous. For example, Col A, E, J, AA and AB need to be in Currency format. I know how to set range for say, Col A through D, but is there a way to do non-continuous columns to the same format with only one command?

4) The part where it does not take so long to run the export if I run fewer records makes me think of my loop. I've included how I do it, is there a better way?

Thank you in advance!

'Set Column Widths:


    .Columns("A").ColumnWidth = 10
    .Columns("B").ColumnWidth = 10
    .Columns("C").ColumnWidth = 10
    .Columns("D").ColumnWidth = 10
    .Columns("E").ColumnWidth = 10
    .Columns("F").ColumnWidth = 35
    .Columns("G").ColumnWidth = 16
    .Columns("H").ColumnWidth = 40

'Format columns:


    .Columns("J").NumberFormat = "$#,##0.00;(-$#,##0.00)"
    .Columns("J").HorizontalAlignment = xlRight
    .Columns("J").WrapText = True
    .Columns("J").VerticalAlignment = xlCenter

    .Columns("A").NumberFormat = "@"
    .Columns("A").HorizontalAlignment = xlCenter
    .Columns("A").WrapText = True
    .Columns("A").VerticalAlignment = xlCenter



'========================


I use a counter for the rows as the number of rows is different every time

    'provide initial value to row counter
    i = 5
    'Loop through recordset and copy data from recordset to sheet
        Do While Not rs1.EOF
        
            .Range("A" & i).Value = Nz(rs1![SITE], "")
            .Range("B" & i).Value = Nz(rs1![AMD], "")
            .Range("C" & i).Value = Nz(rs1![90DAYEL], "")
            .Range("D" & i).Value = Nz(rs1![EndofCQTY], "")




     i = i + 1
     rs1.MoveNext
        
    
    Loop

'==============================


'This is how I switch to the next tab
SQL = "Select * from Inventory_Report"




'Execute query and populate recordset
Set rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)


'If no data, don't bother opening excel, just quit
If rs1.RecordCount = 0 Then
  MsgBox "No Data selected for export", vbInformation + vbOKOnly, "No Data Exported"
  GoTo SubExit
End If
'*****************
'BUILD SPREADSHEET
'*****************
'Create an instance of Excel and start building a spreadsheet
 
Set x1App = Excel.Application
x1App.Visible = False
Set x1Book = x1App.Workbooks.Add
Set x1Sheet = x1Book.Worksheets(1)




With x1Sheet
    .Name = "Inventory Report"
    .Cells.Font.Name = "Calibri"
    .Cells.Font.Size = 11

[Welshgasman]

I would use CopyFromRecordset instead of setting cells individually?
Also make sure you are not opening and closing Excel each time. Open it once and close at the end.

From that code it appears that you do?, else how does the first part work?

[CJ_London]

looping through a recordset is the slowest way to do it. Better to use copyfromrecordset as suggested by WGM or transferspreadsheet

[Johnny12]

I would use CopyFromRecordset instead of setting cells individually?

I will look into this, thanks!

Also make sure you are not opening and closing Excel each time. Open it once and close at the end.

From that code it appears that you do?, else how does the first part work?

I never thought of that. Here is the first part.

Private Sub Command0_Click()Dim x1App As Excel.Application
Dim x1Book As Excel.Workbook
Dim x1Sheet As Excel.Worksheet
Dim SQL As String
Dim rs1 As DAO.Recordset
Dim i As Integer




'Show User Hourglass - work being performed
DoCmd.Hourglass (True)


'***********************************************************************************************************************************************************************************************
'***********************************************************************************************************************************************************************************************
'                                                                               TAB ONE - Master Inventory Report's                                                                                           '
'***********************************************************************************************************************************************************************************************
'***********************************************************************************************************************************************************************************************






SQL = "Select * from Inventory_Report"




'Execute query and populate recordset
Set rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)


'If no data, don't bother opening excel, just quit
If rs1.RecordCount = 0 Then
  MsgBox "No Data selected for export", vbInformation + vbOKOnly, "No Data Exported"
  GoTo SubExit
End If
'*****************
'BUILD SPREADSHEET
'*****************
'Create an instance of Excel and start building a spreadsheet
 
Set x1App = Excel.Application
x1App.Visible = False
Set x1Book = x1App.Workbooks.Add
Set x1Sheet = x1Book.Worksheets(1)




With x1Sheet
    .Name = "Inventory Report"
    .Cells.Font.Name = "Calibri"
    .Cells.Font.Size = 11

[Gicu]

Have a look at this thread, it should help you with the CopyFromRecordset and formatting:
https://www.access-programmers.co.uk.../#post-1798117
Cheers,

[ssanfu]

What I do is record a macro (VBA Code) in Excel, then modify it to work in Access.
For Example

3) So the final Excel report is formatted properly, I do have to set the format for every column individually. Some columns may be currency format, others date, others just general but justified right or left. A small example of this which may add to the problem, I set a WrapText to true for every column individually. I could probably set that for the document just once right? Just not sure how. Or, I have lots of columns with the exact same format, but are not continuous. For example, Col A, E, J, AA and AB need to be in Currency format. I know how to set range for say, Col A through D, but is there a way to do non-continuous columns to the same format with only one command?

[CODE]'Set Column Widths:


.Columns("A").ColumnWidth = 10 '\
.Columns("B").ColumnWidth = 10 ' \
.Columns("C").ColumnWidth = 10 ' | > see Sub Macro1()=>> .Columns("A:E").ColumnWidth = 10

.Columns("D").ColumnWidth = 10 ' /
.Columns("E").ColumnWidth = 10 ' /
.Columns("F").ColumnWidth = 35
.Columns("G").ColumnWidth = 16
.Columns("H").ColumnWidth = 40

Sub Macro1()
'
' Set column width for multiple contiguous columns
'
    Columns("A:E").ColumnWidth = 10
End Sub

'=====================================================

Sub Macro2()
'
' Set Wrap mode for multiple NON-contiguous columns
'
    Range("A:A,C:C,F:F,J:J").ColumnWidth = 15.14
End Sub

'=====================================================

Sub Macro3()
'
' Set Wrap mode for multiple columns
'
    With Columns("A:D")
        .WrapText = True
    End With

'-------------
'          OR
'-------------

    Columns("A:D").WrapText = True

End Sub