Exporting Filtered Data to Excel
Access versions: 2007 – 2013
Level: Intermediate
In Access Archon #200 (Exporting Access Data to Excel), I showed how to export data to an Excel workbook, using various techniques. In this article, I expand on that theme, showing how to export filtered data from Access to multiple worksheets within a workbook, which is very handy if you need to provide editable files of data to users who want to be able to sort and add calculations to the data for their own needs.
The Form
The sample database (Exporting Filtered Data to Excel (AA 228) has only one form, fmnuMain, with a number of options for selecting filters:
This main menu is based on my New Style Main Menu (Access Archon #212), and it has two path selectors, one for the location of your Excel templates (the sample database writes data to workbooks created from three templates), and one for the path where you want to store your workbooks. After selecting these paths for your computer, they are stored in custom database properties and used as needed in VBA code.
When you select an option (Month Range, Salespersons or Countries) in the Filter option group, the appropriate selector controls are activated – the Start Month and End Month combo boxes for selecting a month range, or the Salespersons or Countries listbox for selecting one or more salespersons or countries.
If you select Salespersons or Countries, and select a few items from the multi-select listbox, when you click the big Excel button you will get a workbook with each salesperson’s (or country’s) data on its own sheet:
The Countries workbook is created in a similar manner, with each country’s data on its own sheet.
If you select the Month Range option, after you select a Start Month and End Month for the range, clicking the big Excel button runs code to create a workbook with data for invoices within the range of months, each month on its own sheet:
VBA Code
The code that creates the workbooks is listed below. I use different techniques to create the sheets for different workbooks – in the Salespersons and Countries workbooks, I have a sheet called Headings which is prefilled with column headings; in the Month Range workbook, I create and format the column headings in VBA code.
Private Sub cmdWorkbooks_Click()
On Error GoTo ErrorHandler
Dim shtHeadings As Excel.Worksheet
Dim shtFirst As Excel.Worksheet
Dim appExcel As New Excel.Application
Dim strXLTemplate As String
Dim intSheetNo As Integer
Dim intNoSheets As Integer
Dim intYear As Integer
Dim intMonth As Integer
Dim rstMulti As DAO.Recordset
Dim strSheet As String
Dim strQuery As String
Dim lngOrderID As Long
Dim strSalespersonName As String
Dim strCompany As String
Dim strCountry As String
Dim curUnitPrice As Currency
Dim intQuantity As Integer
Dim sglDiscount As Single
Dim curExtendedPrice As Currency
Dim rstSheets As DAO.Recordset
Dim rstData As DAO.Recordset
Dim dteOrder As Date
Dim strProductName As String
strXLTemplate = GetProperty(“TemplateName”, “”)
Select Case strXLTemplate
Case “Invoices for Salespersons.xltx”
‘Check for selected salespersons
Set lst = Me![lstSelectSalespersons]
‘Check that at least one item has been selected
If lst.ItemsSelected.Count = 0 Then
strTitle = “No items selected”
strPrompt = “Please select at least one salesperson”
MsgBox prompt:=strPrompt, _
Buttons:=vbInformation + vbOKOnly, _
Title:=strTitle
lst.SetFocus
GoTo ErrorHandlerExit
End If
‘Mark selected salespersons in temp table
strTable = “tlkpSalespersons”
Set rst = CurrentDb.OpenRecordset(strTable, dbOpenDynaset)
For Each varItem In lst.ItemsSelected
lngID = Nz(lst.Column(0, varItem))
strSearch = “[SalespersonID] = ” & lngID
rst.FindFirst strSearch
If rst.NoMatch = False Then
rst.Edit
rst![Use] = True
rst.Update
End If
Next varItem
rst.Close
strQuery = “qryInvoicesForSelectedSalespersons”
‘Check for data
If DCount(“*”, strQuery) = 0 Then
strTitle = “No data”
strPrompt = “No data found for these salespersons;” _
& ” canceling”
MsgBox prompt:=strPrompt, _
Buttons:=vbExclamation + vbOKOnly, _
Title:=strTitle
GoTo ErrorHandlerExit
End If
‘Create new workbook from template
strExcelWorkbooksPath = GetProperty(“ExcelWorkbooksPath”, “”)
strExcelTemplatesPath = GetProperty(“ExcelTemplatesPath”, “”)
strTemplate = strExcelTemplatesPath & “” & strXLTemplate
Debug.Print “Template: ” & strTemplate
Set wkb = appExcel.Workbooks.Add(Template:=strTemplate)
Set sht = wkb.Sheets(1)
appExcel.Visible = True
‘Start making worksheets and filling each with one salesperson’s data
intNoSheets = DCount(“*”, “qrySelectedSalespersons”)
Debug.Print intNoSheets & ” sheets to fill”
Set rstSheets = CurrentDb.OpenRecordset(“qrySelectedSalespersons”)
Set rstData = CurrentDb.OpenRecordset(strQuery)
rstSheets.MoveFirst
For intSheetNo = 1 To intNoSheets
Debug.Print “Processing Sheet ” & intSheetNo
Set shtFirst = wkb.Sheets(1)
Set shtHeadings = wkb.Sheets(“Headings”)
shtHeadings.Copy before:=shtFirst
Set sht = wkb.Sheets(1)
strSheet = rstSheets.Fields(1)
sht.Name = strSheet
strTitle = “Invoice Data for ” & strSheet
sht.Range(“A1”).Value = strTitle
sht.Range(“A1”).Font.Bold = True
sht.Range(“A1”).Font.Size = 14
rstSheets.MoveNext
Next intSheetNo
‘Write data for first salesperson to body of worksheet
rstSheets.MoveLast
Do Until rstSheets.BOF
strSheet = rstSheets.Fields(1)
Debug.Print “Filling ” & strSheet & ” sheet”
‘Fill sheet
Set sht = wkb.Sheets(strSheet)
sht.Select
lngRow = 4
With rstData
Do While ![SalespersonName] = strSheet
‘Set variables from current record
lngOrderID = Nz(![OrderID])
strCompany = Nz(![Company])
strCountry = Nz(![Country])
strProductName = Nz(![ProductName])
dteOrder = ![OrderDate]
curUnitPrice = Nz(![UnitPrice])
intQuantity = Nz(![Quantity])
sglDiscount = Nz(![Discount])
curExtendedPrice = Nz(![ExtendedPrice])
sht.Range(“A” & CStr(lngRow)).Value = lngOrderID
sht.Range(“B” & CStr(lngRow)).Value = dteOrder
sht.Range(“C” & CStr(lngRow)).Value = strCompany
sht.Range(“D” & CStr(lngRow)).Value = strCountry
sht.Range(“E” & CStr(lngRow)).Value = strProductName
sht.Range(“F” & CStr(lngRow)).Value = curUnitPrice
sht.Range(“G” & CStr(lngRow)).Value = intQuantity
sht.Range(“H” & CStr(lngRow)).Value = sglDiscount
sht.Range(“I” & CStr(lngRow)).Value = curExtendedPrice
lngRow = lngRow + 1
.MoveNext
Loop
End With
sht.Range(“A4”).Select
rstSheets.MovePrevious
Loop
Case “Invoices for Countries.xltx”
‘Code similar to Salespersons case
Case “Invoices for Month Range.xltx”
‘Check for missing months
Set cbo = Me![cboStartMonth]
If cbo.Value = Null Then
strTitle = “Missing month”
strPrompt = “Please select a start month”
MsgBox prompt:=strPrompt, _
Buttons:=vbExclamation + vbOKOnly, _
Title:=strTitle
txt.SetFocus
GoTo ErrorHandlerExit
End If
Set cbo = Me![cboEndMonth]
If cbo.Value = Null Then
strTitle = “Missing date”
strPrompt = “Please select an end month”
MsgBox prompt:=strPrompt, _
Buttons:=vbExclamation + vbOKOnly, _
Title:=strTitle
txt.SetFocus
GoTo ErrorHandlerExit
End If
strQuery = “qryMultiMonthWorkbookData”
‘Check for data
If DCount(“*”, strQuery) = 0 Then
strTitle = “No data”
strPrompt = “No invoices found for this date range; canceling”
MsgBox prompt:=strPrompt, _
Buttons:=vbExclamation + vbOKOnly, _
Title:=strTitle
GoTo ErrorHandlerExit
End If
‘Create new workbook from template
strExcelWorkbooksPath = GetProperty(“ExcelWorkbooksPath”, “”)
strExcelTemplatesPath = GetProperty(“ExcelTemplatesPath”, “”)
strTemplate = strExcelTemplatesPath & “” & strXLTemplate
Debug.Print “Template: ” & strTemplate
Set wkb = appExcel.Workbooks.Add(Template:=strTemplate)
appExcel.Visible = True
‘Start making worksheets and filling each with one month’s data
intNoSheets = DCount(“*”, “qryMonthYears”)
Set rstSheets = CurrentDb.OpenRecordset(“qryMonthYears”)
Set rstMulti = CurrentDb.OpenRecordset(strQuery)
For intSheetNo = 1 To intNoSheets
Set sht = wkb.Sheets.Add
strSheet = rstSheets.Fields(0)
sht.Name = strSheet
strTitle = “Invoices for ” & strSheet
sht.Range(“A1”).Value = strTitle
sht.Range(“A1”).Font.Bold = True
sht.Range(“A1”).Font.Size = 14
sht.Range(“A1:J1”).Select
With appExcel.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Merge
End With
rstSheets.MoveNext
Next intSheetNo
‘Write data for first month to body of worksheet
rstSheets.MoveLast
Do Until rstSheets.BOF
strSheet = rstSheets.Fields(0)
Debug.Print “Filling “; strSheet & ” sheet”
‘Fill sheet
Set sht = wkb.Sheets(strSheet)
sht.Select
‘Write column heads
sht.Range(“A3”).Value = “Order ID”
sht.Range(“A3”).ColumnWidth = 9
sht.Range(“B3”).Value = “Order Date”
sht.Range(“B3”).ColumnWidth = 13
sht.Range(“C3”).Value = “Company”
sht.Range(“C3”).ColumnWidth = 25
sht.Range(“D3”).Value = “Country”
sht.Range(“D3”).ColumnWidth = 25
sht.Range(“E3”).Value = “Salesperson”
sht.Range(“E3”).ColumnWidth = 20
sht.Range(“F3”).Value = “Product Name”
sht.Range(“F3”).ColumnWidth = 35
sht.Range(“G3”).Value = “Unit Price”
sht.Range(“G3”).ColumnWidth = 9
sht.Range(“H3”).Value = “Quantity”
sht.Range(“H3”).ColumnWidth = 9
sht.Range(“I3”).Value = “Discount”
sht.Range(“I3”).ColumnWidth = 9
sht.Range(“J3”).Value = “Extended Price”
sht.Range(“J3”).ColumnWidth = 14
sht.Range(“A3:J3”).Font.Bold = True
sht.Range(“A3:J3”).Select
With appExcel.Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = 0
.Weight = xlThick
End With
lngRow = 4
With rstMulti
Do While ![MonthYear] = strSheet
‘Set variables from current record
lngOrderID = Nz(![OrderID])
strSalespersonName = Nz(![SalespersonName])
strCompany = Nz(![Company])
strCountry = Nz(![Country])
strProductName = Nz(![ProductName])
dteOrder = ![OrderDate]
curUnitPrice = Nz(![UnitPrice])
intQuantity = Nz(![Quantity])
sglDiscount = Nz(![Discount])
curExtendedPrice = CCur(Nz(![ExtendedPrice]))
sht.Range(“A” & CStr(lngRow)).Value = lngOrderID
sht.Range(“B” & CStr(lngRow)).Value = dteOrder
sht.Range(“C” & CStr(lngRow)).Value = strCompany
sht.Range(“D” & CStr(lngRow)).Value = strCountry
sht.Range(“E” & CStr(lngRow)).Value = strSalespersonName
sht.Range(“F” & CStr(lngRow)).Value = strProductName
sht.Range(“G” & CStr(lngRow)).Value = curUnitPrice
sht.Range(“H” & CStr(lngRow)).Value = intQuantity
sht.Range(“I” & CStr(lngRow)).Value = sglDiscount
sht.Range(“J” & CStr(lngRow)).Value = curExtendedPrice
lngRow = lngRow + 1
.MoveNext
Loop
End With
rstSheets.MovePrevious
Loop
End Select
SaveWorkbook:
strWorkbookName = GetProperty(“WorkbookName”, “”)
strSaveName = strExcelWorkbooksPath & “” _
& strWorkbookName & “.xlsx”
Debug.Print “Save name: ” & strSaveName
wkb.SaveAs FileName:=strSaveName, _
FileFormat:=xlOpenXMLWorkbook
strTitle = “Export successful”
strPrompt = strSaveName & ” created”
MsgBox prompt:=strPrompt, _
Buttons:=vbInformation + vbOKOnly, _
Title:=strTitle
appExcel.Visible = True
ErrorHandlerExit:
Set appExcel = Nothing
Exit Sub
ErrorHandler:
If Err.Number = 3021 Then
GoTo SaveWorkbook
Else
MsgBox “Error No: ” & Err.Number _
& ” in ” & Me.ActiveControl.Name & ” procedure; ” _
& “Description: ” & Err.Description
Resume ErrorHandlerExit
End If
End Sub
References
The code in the sample database needs the following references (in addition to the default references):
Microsoft Office 14.0 Object Library
Microsoft Excel 14.0 Object Library
If you import code or objects into a database of your own, you may need to set one or more of these references. The version number may differ, depending on your Office version; check the version you have. References are set in the References dialog, opened from the VBA window. For more information on working with references, see Access Archon #107, Working with References.
Supporting Files
The zip file containing this article, in Word 97-2003 format, plus the supporting file(s), may be downloaded from the Access Archon page of my Web site, as accarch228zip, which is the last entry in the table of Access Archon columns for Access Watch.
Document Name |
Document Type |
Place in |
Exporting Filtered Data to Excel (AA 228).accdb |
Access 2007-2013 database |
Wherever you want |
Invoices for Countries.xltx |
Excel 2007-2013 template |
The path selected in the Excel Templates Path selector on the main menu |
Invoices for Salespersons.xltx | ||
Invoices for Month Range.xltx |