The Dust Bowl ravaged the Great Plains from Canada down to Texas from 1930-1936/1940. On May 9, 1934, a large storm arose in the Great Plains pushing 350 million tons of topsoil more than 10K feet high, and carried it all the way out to the Atlantic Ocean leaving 1/4 inch of soil on ships off the coast on May 11.
The History Channel produced a show, aptly named “Black Blizzard”, that does an excellent job of presenting the causes, the effects and some of the remedies of the Dust Bowl – Check it out. If you cannot find it on the History Channel, check your favorite used bookstore or Amazon – well worth it.
Today’s post, however, is not about drought, proper farming techniques or plagues of grasshoppers – it is about pushing reporting to Excel. In my previous post on pushing reports to Excel, I showed you how to push reporting from an Excel Workbook to a new Workbook.
An admirable goal for sure, as it separates the presentation layer from the data and business tiers. Today, I will look at how we might push reports to Excel from Access.
Data Prep
First I’ll need to create a Table in an Access Database and define the datatypes for each of the fields.
Now I can upload the data from the Excel Workbook to the Table in Access
Now that I have the data from the Excel Workbook in the Access Table, I want to change the dates so I can test the dynamic nature of the code I introduced in my last post to ensure that as the dates change, the Group Method work properly on transaction dates in the Pivot Table. I will add 2 months to the original transaction dates by using the DateAdd Function in Access.
Read more on the DateAdd Function here
The SQL View of the Query:
SELECT Region, Rep, TrxDate, Score, DateAdd("m",2,[trxDate]) AS NewDate FROM tblPush;
Not I’ll turn that into a Make Table Query to create a new Table named tblPushRev
SELECT Region, Rep, Score, DateAdd("m",2,[trxDate]) AS NewDate INTO tblPushRev FROM tblPush;
Use the SQL clause SELECT INTO to make a new table. Use INSERT INTO to append to an existing table.
Looking good, all of the original dates have been incremented by 2 months. Now I need to add a new Field named TrxDate, Copy the values from NewDate to TrxDate and remove the field “NewDate”.
Add a new Field named TrxDate and set the datatype to “Date”
ALTER TABLE tblPushRev ADD TrxDate Date;
Then I can update the values of TrxDate from NewDate
UPDATE tblPushRev SET TrxDate = NewDate
And remove the NewDate Field
ALTER TABLE tblPushRev DROP COLUMN NewDate;
Here’s the revised table:
Now that I have the data I want in an Access Table, I need to create a query that I can output as my data source to be used for an Excel Table (ListObject Object). However, what if I have 2 different queries that I want to choose from as my data source? What if I have 10…20….etc? I’ll see if I can create a Query Picker so the user can choose a query at run-time to return the desired data to be used for the Pivot Table in Excel.
Add A Form
First, I’ll add a blank form to my database
I added a blank form and saved it as frmQueryPicker.
Form Properties
With the form active and in design mode, I clicked on the Property Sheet Icon on the Ribbon and set these form properties:
- Caption: QueryPicker
- Default View: Single Form
- Record Selector: No
- Navigation Buttons: No
- Control Box: Yes
- Min Max Buttons: None
- Pop Up: Yes
Add A ListBox
I added a ListBox to the form and with the form in design mode, I set the properties of the ListBox:
- Column Count: 1
- RowSource Type: Table/Query
- Bound Column: 1
- On Dbl Click: [Event Procedure]
I also need to add some SQL code to the RowSource Property:
SELECT MSysObjects.Name FROM MSysObjects WHERE (((MSysObjects.Type)=5) AND ((MSysObjects.Name) Not Like "~*")) ORDER BY MSysObjects.Name;
MSysObjects are MS Access System Tables. More on MSysObjects here
MSysObjects.Type)=5 tells the SQL query to only return items that are query objects. Not Like “~*” tells the SQL Query to ignore hidden System Queries.
Note that the 3 queries visible as objects in the Access Navigation Pane are now listed in the ListBox.
Command Button…Open Query
Next, I’ll add a Command Button to my form that can be clicked to open the selected query
- Name: cmdOpen
- Column Count: 1
- RowSource Type: Table/Query
- Bound Column: 1
- On Click: [Event Procedure]
Command Button…Cancel
I’ll add another Command Button to my form so that I can cancel the form:
- Name: cmdCancel
- Caption: Cancel
- Picture: (none)
- On Click: [Event Procedure]
- ControlTip Text: Cancel
CheckBox AutoClose
The last control I would like to add to the form, is a check box to control whether the form should close or not after the query runs:
- Name: chkAutoClose
- Default Value: True
And the check box label:
- Name: lblAutoClose
- Caption: Close after opening Query
Code The Form
Now I need to add a bit of code behind the form so that all of the controls function as intended. First I need a sub to run whichever query the user selected as well as close the form after the query runs if the check box is “ticked”
- Make sure the form is active and in design mode. Right-click on the black box on the upper left corner of the form.
- In the resulting pop-up menu, click on “Build Event”
- In the resulting, “Choose Builder” dialog window, click on “Code Builder”
This will take you to the code module for the form. Note that the default event that came up is the Form Load Event. I don’t need that in this case, so I’ll change the control drop-down to General. Now I’ll create a Sub() to open the selected query and if the check box is ticked, close the form.
Option Explicit Private Sub OpenQuery() 'Declare variables Dim strQueryName As String 'Open selected query strQueryName = Nz(Me.lstQueries.Value, "") If Len(strQueryName) > 0 Then DoCmd.OpenQuery strQueryName 'Close form If Me.chkAutoClose.Value = True Then DoCmd.Close acForm, Me.Name End Sub
Now I’ll add the event handlers for the Command Button Click-Events and the Double-click event for the ListBox:
Cancel Button Click Event:
Private Sub cmdCancel_Click() 'if the user clicks the cancel button, close the form DoCmd.Close acForm, Me.Name End Sub
Open Button Click Event:
Private Sub cmdOpen_Click() 'Call the OpenQuery Sub() 'Will open the selected query CreateReport End Sub
ListBox Double Click Event:
Private Sub lstQueries_DblClick(Cancel As Integer) 'Call the OpenQuery Sub() 'Will open the selected query CreateReport End Sub
I ran the process by double-clicking on the “qryExcelData” query in the ListBox. The query results are displayed and the form closed as expected. I opened the form again in the foreground just for purposes of the screen shot.
All of the Access Tables, Queries, Forms, and VBA are complete, tested and working properly.
And Now For Something Completely Different…
I’m no magician. I cannot pull Rocky out of a magic hat as Bullwinkle is doing here. But I might be able to push Excel reporting from MS Access.
edit: As is my usual practice, I am going to use Late Binding in the sample snippets below. A discussion on Late / Early Binding is beyond the scope of this post. Please see these links for a detailed explanation of Late / Early Binding.
Excel Constants
Because I am using Late Binding, Access will not have knowledge of Excel Type Enumerations, so I will need to add several Constants to my project. I won’t use all of the constants below in this project, but since I was looking up the various Types below, I went ahead and created constants for the full Enumerations for each Type:
'XlListObjectSourceType Enumeration (Excel) 'Info: https://msdn.microsoft.com/en-us/library/office/ff820815.aspx '------------------------------------------------------------------- Public Const gclxlSrcExternal As Long = 0 'External data source (Microsoft SharePoint Foundation site). Public Const gclxlSrcModel As Long = 4 'PowerPivot Model Public Const gclxlSrcQuery As Long = 3 'Query Public Const gclxlSrcRange As Long = 1 'Range Public Const gclxlSrcXml As Long = 2 'XML 'XlReferenceStyle Enumeration (Excel) 'Info: https://msdn.microsoft.com/en-us/library/office/ff821207.aspx '--------------------------------------------------------------------- Public Const gclxlA1 As Long = 1 'Default. Use xlA1 to return an A1-style reference. Public Const gclxlR1C1 As Long = -4150 'Use xlR1C1 to return an R1C1-style reference. 'XlPivotTableSourceType Enumeration (Excel) 'Info: https://msdn.microsoft.com/en-us/library/office/ff836220.aspx '----------------------------------------------------------------------- Public Const gclxlConsolidation As Long = 3 'Multiple consolidation ranges. Public Const gclxlDatabase As Long = 1 'Microsoft Excel list or database. Public Const gclxlExternal As Long = 2 'Data from another application. Public Const gclxlPivotTable As Long = -4148 'Same source as another PivotTable report. Public Const gclxlScenario As Long = 4 'Data is based on scenarios created using the Scenario Manager. 'XlPivotFieldOrientation Enumeration(Excel) 'Info: https://msdn.microsoft.com/en-us/library/office/ff835617.aspx '----------------------------------------------------------------------- Public Const gclxlColumnField As Long = 2 'Column Public Const gclxlDataField As Long = 4 'Data Public Const gclxlHidden As Long = 0 'Hidden Public Const gclxlPageField As Long = 3 'Page Public Const gclxlRowField As Long = 1 'Row 'XlConsolidationFunction Enumeration(Excel) 'Info: https://msdn.microsoft.com/en-us/library/office/ff837374.aspx '----------------------------------------------------------------------- Public Const gclxlAverage As Long = -4106 'Average. Public Const gclxlCount As Long = -4112 'Count. Public Const gclxlCountNums As Long = -4113 'Count numerical values only. Public Const gclxlDistinctCount As Long = 111 'Count using Distinct Count analysis. Public Const gclxlMax As Long = -4136 'Maximum. Public Const gclxlMin As Long = -4139 'Minimum. Public Const gclxlProduct As Long = -4149 'Multiply. Public Const gclxlStDev As Long = -4155 'Standard deviation, based on a sample. Public Const gclxlStDevP As Long = -4156 'Standard deviation, based on the whole population. Public Const gclxlSum As Long = -4157 'Sum. Public Const gclxlUnknown As Long = 1000 'No subtotal function specified. Public Const gclxlVar As Long = -4164 'Variation, based on a sample. Public Const gclxlVarP = -4165 'Variation, based on the whole population.
Is Excel Running Or Create Excel
First, I’ll create a Function to check whether Excel is already running or not. If Excel is running – use that instance, otherwise, create a new instance of Excel:
Option Explicit Public Function GetXlApp() As Object 'Get Excel Application 'Declare objects Dim xlApp As Object 'Check if app is already running, if not, create app On Error Resume Next ' Set xlApp = GetObject(, "Excel.Application") If Err Then Set xlApp = CreateObject("Excel.Application") End If On Error GoTo 0 'Pass object to function Set GetXlApp = xlApp 'Tidy up Set xlApp = Nothing End Function
Now that I have an instance of Excel, I need to add a Workbook to that instance:
Option Explicit Public Function GetXlWorkbook(xlApp As Object) As Object 'Add a workbook to the instance of Excel 'Returns an Excel Workbook Object 'Declare objects Dim xlBook As Object 'Error handler On Error GoTo ErrHandler 'Add a workbook Set xlBook = xlApp.Workbooks.Add 'Pass object to function Set GetXlWorkbook = xlBook ErrHandler: If Err.Number > 0 Then _ MsgBox Err.Description, vbMsgBoxHelpButton, "Get workbook", Err.HelpFile, Err.HelpContext 'Tidy up Set xlBook = Nothing End Function
Now that I have a Workbook, I need a Worksheet to hold the data that I am going to export from Access:
Option Explicit Public Function AddWorksheet(wb As Object, _ strSheetName As String) As Object 'Declare variables Dim ws As Object Dim strMySheetName As String 'Error handler On Error GoTo ErrHandler 'Add worksheet With wb Set ws = .Sheets.Add(After:=.Sheets(wb.Sheets.Count)) ws.Name = strSheetName End With 'Pass object to function Set AddWorksheet = ws ErrHandler: If Err.Number > 0 Then _ MsgBox Err.Description, vbMsgBoxHelpButton, "Add a worksheet", Err.HelpFile, Err.HelpContext 'Tidy up Set ws = Nothing End Function
Now that I have a Worksheet, I need a Range to output the query results to:
'Small snippet of main procedure 'Get Excel Range Set xlRange = xlWorksheetData.Range("A2")
Transfer Data From DAO Recordset To Excel
As part of my main procedure I load the results of the user-selected query into a DAO Recordset. The entire main procedure is at bottom. Here is the DAO Recordset snippet:
'Get database, query definition and recordset objects Set db = CurrentDb Set qdf = db.QueryDefs(strQueryName) Set rs = qdf.OpenRecordset
Now I can use the CopyFromRecordset Method of the Range Object to copy the query results from Access to Excel:
'Small snippet of main procedure 'Copy the recordset to the Excel Range xlRange.CopyFromRecordset rs
The CopyFromRecordset Method only copies the records of the recordset, not the Field Headers, so I need to copy those to the Excel Worksheet separately:
'Small snippet of main procedure 'Copy field headers from the recordset to the Excel Worksheet For i = 1 To rs.Fields.Count xlWorksheetData.Cells(1, i).Value = rs.Fields(i - 1).Name Next i
The selected query has been output to an Excel Worksheet (inset).
Add A ListObject To The New Range
I want to use a ListObject (Excel Table) as the data source for a Pivot Cache, so I’ll add a ListObject directly over the Range Object:
Option Explicit Public Function GetListObject(ws As Object) 'Declare objects Dim rng As Object Dim C As Object Dim lo As Object Dim xlSrcRange As Object 'Error handler On Error GoTo ErrHandler 'Create range object Set rng = ws.UsedRange Set C = rng.Cells(1, 1) 'Add listobject Set lo = ws.ListObjects.Add( _ SourceType:=gclxlSrcRange, _ Source:=rng, _ Destination:=C) 'Pass the object to the function Set GetListObject = lo ErrHandler: If Err.Number > 0 Then _ MsgBox Err.Description, vbMsgBoxHelpButton, "Get ListObject", Err.HelpFile, Err.HelpContext 'Tidy up Set lo = Nothing Set C = Nothing Set rng = Nothing End Function
Add A Pivot Cache
I just added a ListObject (Excel Table). I’ll use that as the data source for a Pivot Cache:
Option Explicit Public Function GetPivotCache(wb As Object, _ lo As Object) 'Declare Objects Dim pc As Object 'Declare variables Dim strPivotCacheSource As String 'Error handler On Error GoTo ErrHandler 'Pivot cache source strPivotCacheSource = lo.Parent.Name & "!" & _ lo.Range.Address(ReferenceStyle:=gclxlR1C1) 'Create pivot cache Set pc = wb.PivotCaches.Create( _ SourceType:=gclxlDatabase, _ SourceData:=strPivotCacheSource) 'Pass object to function Set GetPivotCache = pc ErrHandler: If Err.Number > 0 Then _ MsgBox Err.Description, vbMsgBoxHelpButton, "Get pivot cache", Err.HelpFile, Err.HelpContext 'Tidy up Set pc = Nothing End Function
Add A Worksheet For The Pivot Table Report
Now that I have a Pivot Cache, I need to add a Worksheet for the Pivot Table Report:
Option Explicit Public Function AddWorksheet(wb As Object, _ strSheetName As String) As Object 'Declare variables Dim ws As Object Dim strMySheetName As String 'Error handler On Error GoTo ErrHandler 'Add worksheet With wb Set ws = .Sheets.Add(After:=.Sheets(wb.Sheets.Count)) ws.Name = strSheetName End With 'Pass object to function Set AddWorksheet = ws ErrHandler: If Err.Number > 0 Then _ MsgBox Err.Description, vbMsgBoxHelpButton, "Add a worksheet", Err.HelpFile, Err.HelpContext 'Tidy up Set ws = Nothing End Function
Add A Pivot Table
Now that I have a Worksheet, I can add a Pivot Table:
Option Explicit Public Function GetPivotTable(pc As Object, _ ws As Object, _ strPivotTableName As String, _ Optional ByVal lngRowPlacement As Long = 3, _ Optional ByVal lngColPlacement As Long = 3) 'Declare Objects Dim pt As Object Dim rng As Object 'Declare variables Dim strPivotPlacement As String 'Error handler On Error GoTo ErrHandler 'Create range Set rng = ws.Cells(lngRowPlacement, lngColPlacement) 'Pivot table placement strPivotPlacement = ws.Name & "!" & _ rng.Address(ReferenceStyle:=gclxlR1C1) 'Create pivot table Set pt = pc.CreatePivotTable( _ TableDestination:=strPivotPlacement, _ TableName:=strPivotTableName) 'Pass object to function Set GetPivotTable = pt ErrHandler: If Err.Number > 0 Then _ MsgBox Err.Description, vbMsgBoxHelpButton, "Get pivot table", Err.HelpFile, Err.HelpContext 'Tidy up Set rng = Nothing Set pt = Nothing End Function
Add Pivot Fields To Pivot Table
Now that I have a Pivot Table, I can add Pivot Fields. I am using a Select Case Statement to handle the correct Pivot Fields based on the name of the query the user selected. You will need to add additional Case Statements as you add more queries that require different fields and different consolidation functions (see global constants above):
Option Explicit Public Sub AddFieldsToPivot(pt As Object, _ strQuery As String) 'Error handler On Error GoTo ErrHandler 'Add fields to pivot table With pt Select Case strQuery Case "qryExcelData" 'Row fields .PivotFields("Region").Orientation = gclxlRowField .PivotFields("Region").Position = 1 .PivotFields("Reps").Orientation = gclxlRowField .PivotFields("Reps").Position = 2 'Column fields .PivotFields("TrxDate").Orientation = gclxlColumnField .PivotFields("TrxDate").Position = 1 'Value fields .AddDataField .PivotFields("Score"), _ Caption:="Avgerage of Score", _ Function:=gclxlAverage Case Else MsgBox "The selected query is not an option for a Pivot Table" Err.Raise 513 'Custom error End Select End With ErrHandler: If Err.Number > 0 Then _ MsgBox Err.Description, vbMsgBoxHelpButton, "Get pivot table fields", Err.HelpFile, Err.HelpContext Err.Clear End Sub
Group Dates By Month
Notice that the Pivot Table currently displays each day in a Column Field. I would prefer to group the dates based on the month. I can achieve this by using the Group Method of the Range Object. So first I will need to find the Range to group.
Get A Range From A Pivot Table
I need to get the first Cell in the PivotField “TrxDate” DataRange, so I’ll use the Pivot Item DataRange.
Read more on various ranges within a pivot table and their special VBA range names on Jon Peltier’s site
Option Explicit Public Function GetPivotTableRange(pt As Object, _ strRangeType As String, _ Optional ByVal strPivotField As String = vbNullString) As Object 'Pivot field Range type documentation: 'http://peltiertech.com/referencing-pivot-table-ranges-in-vba/ <-Jon Peltier 'String range types: 'PivotItemDataRange 'DataBodyRange 'Declare objects Dim rng As Object 'Error handler On Error GoTo ErrHandler 'Create pivot table range Select Case strRangeType Case "PivotItemDataRange" Set rng = pt.PivotFields(strPivotField).DataRange.Cells(1, 1) Case "DataBodyRange" Set rng = pt.DataBodyRange Case Else MsgBox "That is not an option" Err.Raise 513 End Select 'Pass object to function Set GetPivotTableRange = rng ErrHandler: If Err.Number > 0 Then _ MsgBox Err.Description, vbMsgBoxHelpButton, "Get pivot table range", Err.HelpFile, Err.HelpContext 'Tidy up Set rng = Nothing End Function
Note that I set the rng object to just the first cell of the Range actually returned by the DataRange.
Group Pivot Table Dates
Now that I have the first cell of the DataRange, I am ready to group the range. Recall, I want to group dates by month. One of the optional parameters of the Group Method is Periods; which is an array of Boolean values that specify the period for the group.
Read more on the Group Method of the Range Object here
The snippet from the main procedure. Note that I set the 5th element of the Array to “True”. This specifies that the grouping should be by months as per the documentation on MSDN.
'Group pivot table dates Periods = Array(False, False, False, False, True, False, False) Call GroupRange(rng:=xlPivotTableRange, _ varrPeriods:=Periods)
And the Group Range Sub():
Option Explicit Public Sub GroupRange(rng As Object, _ varrPeriods() As Variant) '============================================================================= 'Uses the Group Method of the Range Object 'Only works if Range Object is single cell in PivotTable field’s data range 'https://msdn.microsoft.com/EN-US/library/office/ff839808.aspx 'Group(Start, End, By, Periods) 'Array element Period '---------------------- '1 Seconds '2 Minutes '3 Hours '4 Days '5 Months '6 Quarters '7 Years '============================================================================== 'Declare objects Dim C As Object 'Error handler On Error GoTo ErrHandler 'Get first cell of range Set C = rng.Cells(1, 1) 'Group range C.Group _ Periods:=varrPeriods() ErrHandler: If Err.Number > 0 Then _ MsgBox Err.Description, vbMsgBoxHelpButton, "Group pivot field data range", Err.HelpFile, Err.HelpContext 'Tidy up Set C = Nothing End Sub
The individual dates in the Column Fields have been grouped by month and the groups have been collapsed to display just the average score for each Rep for each month.
Format DataFields
The Pivot Table is looking good, next I would like to format the DataFields to only display to the hundredths:
Public Sub FormatPivotField(pt As Object) 'Declare objects Dim pf As Object 'Error handler On Error GoTo ErrHandler 'Format datafields With pt For Each pf In .DataFields pf.NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)" Next pf End With ErrHandler: If Err.Number > 0 Then _ MsgBox Err.Description, vbMsgBoxHelpButton, "Format DataFields", Err.HelpFile, Err.HelpContext End Sub
Set The Column Widths
Another way to improve readability of the Pivot Table is to set all columns to a consistent width:
Option Explicit Public Sub PivotTableRangeColWidth(pt As Object) 'Declare objects Dim rng As Object 'Error handler On Error GoTo ErrHandler 'Get range oject from pivot table Set rng = GetPivotTableRange(pt:=pt, _ strRangeType:="DataBodyRange") 'Set column width rng.ColumnWidth = 15 ErrHandler: If Err.Number > 0 Then _ MsgBox Err.Description, vbMsgBoxHelpButton, "Range Column Width", Err.HelpFile, Err.HelpContext 'Tidy up Set rng = Nothing End Sub
There is a lot more I could do to format the final Pivot Table, but this post is already long enough.
The Main Sub()
Here’s the Main Sub() that calls all other Functions() and Subs()
Option Explicit Private Sub CreateReport() 'Declare objects Dim db As DAO.Database Dim qdf As DAO.QueryDef Dim rs As DAO.Recordset Dim xlApplication As Object Dim xlWorkbook As Object Dim xlWorksheetData As Object Dim xlWorksheetReport As Object Dim xlRange As Object Dim xlListObject As Object Dim xlPivotCache As Object Dim xlPivotTable As Object Dim xlPivotTableRange As Object 'Declare variables Dim strQueryName As String Dim i As Long Dim Periods() As Variant 'Error handler On Error GoTo ErrHandler 'Open selected query strQueryName = Nz(Me.lstQueries.Value, "") If Len(strQueryName) > 0 Then DoCmd.OpenQuery strQueryName 'Close form If Me.chkAutoClose.Value = True Then DoCmd.Close acForm, Me.Name 'Get database, query definition and recordset objects Set db = CurrentDb Set qdf = db.QueryDefs(strQueryName) Set rs = qdf.OpenRecordset 'Get Excel Application Set xlApplication = GetXlApp() xlApplication.Visible = True 'Get Excel Workbook Set xlWorkbook = GetXlWorkbook(xlApp:=xlApplication) 'Get Excel Worksheet Set xlWorksheetData = xlWorkbook.Worksheets(1) xlWorksheetData.Name = "Data" 'Get Excel Range Set xlRange = xlWorksheetData.Range("A2") 'Copy the recordset to the Excel Range xlRange.CopyFromRecordset rs 'Copy field headers from the recordset to the Excel Worksheet For i = 1 To rs.Fields.Count xlWorksheetData.Cells(1, i).Value = rs.Fields(i - 1).Name Next i 'Add a ListObject Object Set xlListObject = GetListObject(ws:=xlWorksheetData) 'Add a Pivot Cache Set xlPivotCache = GetPivotCache(wb:=xlWorkbook, _ lo:=xlListObject) 'Add a worksheet for the pivot table Set xlWorksheetReport = AddWorksheet(wb:=xlWorkbook, _ strSheetName:="rpt") 'Add a pivot table Set xlPivotTable = GetPivotTable(pc:=xlPivotCache, _ ws:=xlWorksheetReport, _ strPivotTableName:="PivotTable1") 'Add pivot fields to pivot table Call AddFieldsToPivot(pt:=xlPivotTable, _ strQuery:=strQueryName) 'Get pivot table range to group Set xlPivotTableRange = GetPivotTableRange(pt:=xlPivotTable, _ strRangeType:="PivotItemDataRange", _ strPivotField:="TrxDate") 'Group pivot table dates Periods = Array(False, False, False, False, True, False, False) Call GroupRange(rng:=xlPivotTableRange, _ varrPeriods:=Periods) 'Format pivot table values Call FormatPivotField(pt:=xlPivotTable) 'Format pivot table column width Call PivotTableRangeColWidth(pt:=xlPivotTable) ErrHandler: If Err.Number > 0 Then _ MsgBox Err.Description, vbMsgBoxHelpButton, "Create Report", Err.HelpFile, Err.HelpContext 'Tidy up Set rs = Nothing Set qdf = Nothing Set db = Nothing Set xlRange = Nothing Set xlPivotTableRange = Nothing Set xlListObject = Nothing Set xlPivotTable = Nothing Set xlPivotCache = Nothing Set xlWorksheetData = Nothing Set xlWorksheetReport = Nothing Set xlWorkbook = Nothing Set xlApplication = Nothing End Sub
Homework
There’s more I could do here, but this post is long enough and I wanted to leave some meat on the bone. Additional items to be added:
- Additional Pivot Tables
- Charts and/or Pivot Charts
- Slicer Cache
- Slicers
- Worksheet Display Settings
- Page Setup Settings For Printing
Downloads
You may download the Access Database and/or the code modules (.bas files) from OneDrive.
- Push.accdb
- Form_frmQueryPicker.cls
- M_Globals.bas
- M_GroupPivotTableRange.bas
- M_PushToExcel.bas
- M_XlAddWorksheet.bas
- M_XlApp.bas
- M_XlFormatPivotField.bas
- M_XlListObjects.bas
- M_XlPivotCache.bas
- M_XlPivotFields.bas
- M_XlPivotTable.bas
- M_XlPivotTableRange.bas
- M_XlPivotTableRangeColWidth.bas
- M_xlWorkbook.bas
Additional Pivot Table Resources – Around The Excel Horn
Some authors of my favorite resources for working with Pivot Tables:
Additional Pivot Table Resources – dataprose.org
Some additional resources for working with Pivot Tables on my blog
- Push To Excel
- Bordering On The Edge [Excel PivotTables]
- PivotTable Flash: Conditional Formatting
- PivotTable Flash: Hide Field Captions
- PivotTable Flash: Change Font Color of Field Captions
- PivotTable Flash: Hide Field Captions – Custom Number Format Option
Tidy Up
That’s all for today. A very long post – even by my standards. Storing data in a database (even if small and simple as Access) and then working with that data for reporting purposes in Excel makes a lot of sense. Highly recommended!
Thank for that post. It will solve the issue I have with creation of table using late binding. https://stackoverflow.com/questions/44171146/listobjects-creation-late-binding-from-access-to-excel