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