CODEWITHSUNDEEP
excelms-accessvbaexport-to-excel
ealfons1
ealfons1

Reputation: 373

Export Access data into Excel workbook and split data into multiple sheets based on column value

Sample data (local Access table called 'Pets_data_table')

ID | Pet_Type | Pet_Owner

1      Dog        Jane Doe         
2      Cat        John Doe
3      Hamster    Bob Doe
4      Dog        Melissa Doe 
5      Cat        Aaron Doe

At the moment, I can export the data in this table to one Excel workbook, and split the data into multiple sheets within that Excel workbook according to distinct values of a specific field. I use the following VBA to split the data according to distinct values of the 'Pet_Type' field:

    Dim db As DAO.Database
    Set db = CurrentDb()
    Dim strPath As String
    strPath = "C:\Desktop\" & "Pets_dataset_export_" & format(date(),"yyyy-mm-dd") & ".xlsx" 
    DoCmd.TransferSpreadsheet acExport, 10, "Qry - Dog", strPath, True, "Dog"
    DoCmd.TransferSpreadsheet acExport, 10, "Qry - Cat", strPath, True, "Cat"
    DoCmd.TransferSpreadsheet acExport, 10, "Qry - Hamster", strPath, True, "Hamster"

    Set db = Nothing
    MsgBox "Export operation completed"

This performs well when the field I am splitting the data with has a small number of distinct values.

However, it is inefficient when there are a large number of distinct values in the field I want to split the data with.

I would like to implement a more dynamic approach that allows me to split a dataset with a field that has 1...n number of distinct values.

Upvotes: 1

Views: 4164

Answers (1)

HansUp
HansUp

Reputation: 97131

Load a single recordset based on a query which gives you the unique pet types ...

SELECT DISTINCT p.Pet_Type
FROM Pets_data_table AS p;

Then walk that recordset, alter a saved query (qryExportMe) to SELECT the current Pet_Type, and export the query ...

Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strPath As String
Dim strSelectOneType As String
Dim strSelectPetTypes As String

' (change strPath back to what you need)
strPath = CurrentProject.Path & Chr(92) & "Pets_dataset_export_" & _
    Format(Date, "yyyy-mm-dd") & ".xlsx"
strSelectPetTypes = "SELECT DISTINCT p.Pet_Type" & vbCrLf & _
    "FROM Pets_data_table AS p;"

Set db = CurrentDb
Set rs = db.OpenRecordset(strSelectPetTypes, dbOpenSnapshot)
Do While Not rs.EOF
    strSelectOneType = "SELECT p.ID, p.Pet_Type, p.Pet_Owner" & vbCrLf & _
        "FROM Pets_data_table AS p" & vbCrLf & _
        "WHERE p.Pet_Type='" & rs!Pet_Type.Value & "';"
    Debug.Print strSelectOneType
    Set qdf = db.QueryDefs("qryExportMe")
    qdf.SQL = strSelectOneType
    qdf.Close
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _
        "qryExportMe", strPath, True, rs!Pet_Type.Value
    rs.MoveNext
Loop
rs.Close

Note that code requires that the saved query, qryExportMe, exists. But its SQL property doesn't matter because you'll change it each time through the main Do While loop.

Upvotes: 2

Related Questions