Exporting Filtered Data to Excel

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:

http://img.office-watch.com/waw/AW%201603-A.jpg image from Exporting Filtered Data to Excel at Office-Watch.com

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:

http://img.office-watch.com/waw/AW%201603-B.jpg image from Exporting Filtered Data to Excel at Office-Watch.com

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:

http://img.office-watch.com/waw/AW%201603-C.jpg image from Exporting Filtered Data to Excel at Office-Watch.com


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])

Windows 10 from people 'in the know'

A detailed and independent look at Windows 10, especially written for the many people who use Microsoft Office.

Fully up-to-date with coverage of the Anniversary 2016 major update of Windows 10.

This 670 page book shows you important features and details for all serious Windows 10 users.

                 

                  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