Ahhh, mowing the lawn. Going to William’s 66 to buy some fuel. The smell of the gas, the fresh cut grass, fighting the fly-wheel, trying to get perfectly straight lines, rushing to beat the encroaching summer storm, getting a little too close to mom’s peonies – oops!
I traded a mix of Bluegrass, Rye and Fescue of the Midwest a long time ago for the rusty reddish brown that dominates the landscape of the American Southwest. Still, at times, it is great to remember simpler days.
Today’s post, however, is not about how to maintain a 4-Cycle Briggs & Stratton engine. Rather, it is about how to push reporting to Excel.
The Debate
Push to Excel or Pull to Excel? I go back and forth. For me, it depends on my end in mind. If I am completing a corporate model/template – I am more likely to pull data into Excel from other Excel workbooks or various databases. However, if I am creating reports – especially ad hoc – then pushing to Excel might make more sense. Let’s take a look.
Is Excel Running Or Create A New Instance Of Excel
The first thing I want to do, is determine if Excel is running. If Excel is running, use the current instance of Excel, otherwise, create a new instance of Excel.
Option Explicit Public Function GetXlApp() As Excel.Application 'Declare objects Dim App As Excel.Application 'Check if Excel is running On Error Resume Next Set App = GetObject(, "Excel.Application") On Error GoTo 0 'Create Excel if it is not already running If App Is Nothing Then Set App = CreateObject("Excel.Application") End If 'Pass object to function Set GetXlApp = App 'Tidy up Set App = Nothing End Function
Create Workbook
Now that I have an instance of Excel, I need to add a new Workbook and Worksheet to the instance of Excel
'Add workbook object Set xlBook = xlApp.Workbooks.Add 'Create worksheet object Set xlSheet = xlBook.Worksheets(1)
So far, I have created an instance of Excel and added a Workbook and Worksheet to that instance.
Transfer Data From Source To Destination
Now that I have a new instance of Excel and a workbook and worksheet in that instance, I can transfer the data from my source workbook to he new workbook
'Get rows and columns of region With rngCurrent rngRows = .Rows.Count rngCols = .Columns.Count End With 'Resize destination range With xlSheet Set xlRange = .Range("A1") Set xlRange = xlRange.Resize(rngRows, rngCols) End With 'Transfer range values xlRange.Value = rngCurrent.Value
The data has been transferred from the source workbook to the new workbook. Note how I use rngNew.value = rngOld.value so I do not rely on copy/paste using the Windows Clipboard.
Add A ListObject To The New Range
I’m a huge fan of ListObject Objects (a.k.a. Excel Tables) Are you? Why or why not? Let’s add one to the new workbook to the range of data just transferred.
'Add a listobject Set xlListObject = GetListObject(ws:=xlSheet) Option Explicit Public Function GetListObject(ws As Worksheet) 'Declare objects Dim rng As Range Dim C As Range Dim lo As ListObject '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:=xlSrcRange, _ 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
A ListObject Object (Excel Table) has been added, I chose to place it exactly where the Range existed previously, I could have put it anywhere. However, since the Range Object and the ListObject Object contain the same data, why keep both? I now have a ListObject which will automatically expand in case someone decides to add additional information after the data was pushed from an external data source.
Add a Pivot Cache
To add a Pivot Table, I need a Pivot Cache. I’ll use the Excel Table as the data source for the Pivot Cache.
'Add a pivot cache Set xlPivotCache = GetPivotCache(wb:=xlBook, _ lo:=xlListObject) Public Function GetPivotCache(wb As Workbook, _ lo As ListObject) 'Declare Objects Dim pc As PivotCache 'Declare variables Dim strPivotCacheSource As String 'Error handler On Error GoTo ErrHandler 'Pivot cache source strPivotCacheSource = lo.Parent.Name & "!" & _ lo.Range.Address(ReferenceStyle:=xlR1C1) 'Create pivot cache Set pc = wb.PivotCaches.Create( _ SourceType:=xlDatabase, _ 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
'Add a sheet for the pivot table Set xlSheetReport = AddWorksheet(wb:=xlBook, _ strSheetName:="rpt") Public Function AddWorksheet(wb As Workbook, _ strSheetName As String) As Worksheet 'Declare variables Dim ws As Worksheet 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
I now have a new Worksheet to hold the Pivot Table.
Add a Pivot Table
Now that I have a new Worksheet, I can add a Pivot Table
'Add a pivot table Set xlPivotTable = GetPivotTable(pc:=xlPivotCache, _ ws:=xlSheetReport, _ strPivotTableName:="PivotTable1") Public Function GetPivotTable(pc As PivotCache, _ ws As Worksheet, _ strPivotTableName As String, _ Optional ByVal lngRowPlacement As Long = 3, _ Optional ByVal lngColPlacement As Long = 3) 'Declare Objects Dim pt As PivotTable Dim rng As Range '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:=xlR1C1) '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
Now that I have a Pivot Table, I can add Pivot Fields.
Add Pivot Fields To Pivot Table
Now that I have a Pivot Table, I need to specify which fields to use from the Excel Table and their Orientation and Order in the Pivot Table:
Private Sub AddFieldsToPivot(pt As PivotTable) 'Error handler On Error GoTo ErrHandler 'Add fields to pivot table With pt 'Row fields .PivotFields("Region").Orientation = xlRowField .PivotFields("Region").Position = 1 .PivotFields("Reps").Orientation = xlRowField .PivotFields("Reps").Position = 2 'Column fields .PivotFields("TrxDate").Orientation = xlColumnField .PivotFields("TrxDate").Position = 1 'Value fields .AddDataField .PivotFields("Score"), _ Caption:="Avgerage of Score", _ Function:=xlAverage End With ErrHandler: If Err.Number > 0 Then _ MsgBox Err.Description, vbMsgBoxHelpButton, "Get pivot table fields", Err.HelpFile, Err.HelpContext 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
'Get pivot table range to group Set xlPivotTableRange = GetPivotTableRange(pt:=xlPivotTable, _ strRangeType:="PivotItemDataRange", _ strPivotField:="TrxDate") Public Function GetPivotTableRange(pt As PivotTable, _ strRangeType As String, _ Optional ByVal strPivotField As String = vbNullString) As Range 'Pivot field Range type documentation: 'http://peltiertech.com/referencing-pivot-table-ranges-in-vba/ <-Jon Peltier 'String range types: 'PivotItemDataRange 'Declare objects Dim rng As Range '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 Else MsgBox "That is not an option" Exit Function 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. Also, note that the Select Case statement is only the beginning of the function that handles one simple case of a special VBA range name. I will revisit this function later and update it with all of the special VBA range names of a Pivot Table as Jon documents on his site.
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
'Group pivot table dates Periods = Array(False, False, False, False, True, False, False) Call GroupRange(rng:=xlPivotTableRange, _ varrPeriods:=Periods)
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. Here is the Sub() that I am calling:
Public Sub GroupRange(rng As Range, _ 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 Range '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:
Private Sub FormatPivotField(pt As PivotTable) 'Declare objects Dim pf As PivotField '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. I can set the ColumnWidth of a Range Object, so I’ll use the Function I created earlier to get a special VBA range from the Pivot Table. This time I want to use the DataBodyRange, so first I’ll modify my function to add the new Range Type. Here if the modified function:
Public Function GetPivotTableRange(pt As PivotTable, _ strRangeType As String, _ Optional ByVal strPivotField As String = vbNullString) As Range '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 Range '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" Exit Function 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
And here is the Sub{} that calls the function to set the column width:
Public Sub PivotTableRangeColWidth(pt As PivotTable) 'Declare objects Dim rng As Range '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
And the Pivot Table with the DataBodyRange set to a ColumnWidth of 15
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 Sub PushToExcel() 'Declare objects Dim wbCurrent As Workbook Dim wsCurrent As Worksheet Dim rngCurrent As Range Dim rng As Range Dim xlPivotTableRange As Range Dim xlRange As Range Dim xlApp As Object Dim xlBook As Object Dim xlSheet As Object Dim xlSheetReport As Object Dim xlListObject As Object Dim xlPivotCache As Object Dim xlPivotTable As Object 'Declare variables Dim rngRows As Long Dim rngCols As Long Dim Periods() As Variant 'Current objects Set wbCurrent = ActiveWorkbook Set wsCurrent = wbCurrent.ActiveSheet Set rngCurrent = wsCurrent.UsedRange 'Get Excel app On Error Resume Next Set xlApp = GetXlApp If Not xlApp Is Nothing Then xlApp.Visible = True Else MsgBox "The application was not created. Exiting." Exit Sub End If 'Add workbook Set xlBook = xlApp.Workbooks.Add 'Create worksheet object Set xlSheet = xlBook.Worksheets(1) 'Get rows and columns of region With rngCurrent rngRows = .Rows.Count rngCols = .Columns.Count End With 'Resize destination range With xlSheet Set xlRange = .Range("A1") Set xlRange = xlRange.Resize(rngRows, rngCols) End With 'Transfer range values xlRange.Value = rngCurrent.Value 'Add a listobject Set xlListObject = GetListObject(ws:=xlSheet) 'Add a pivot cache Set xlPivotCache = GetPivotCache(wb:=xlBook, _ lo:=xlListObject) 'Add a sheet for the pivot table Set xlSheetReport = AddWorksheet(wb:=xlBook, _ strSheetName:="rpt") 'Add a pivot table Set xlPivotTable = GetPivotTable(pc:=xlPivotCache, _ ws:=xlSheetReport, _ strPivotTableName:="PivotTable1") 'Add fields to pivot table Call AddFieldsToPivot(pt:=xlPivotTable) '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 Call FormatPivotField(pt:=xlPivotTable) 'Set column width pivot table data body Call PivotTableRangeColWidth(pt:=xlPivotTable) 'Tidy up 'Destroy objects Set rngCurrent = Nothing Set xlRange = Nothing Set xlPivotTableRange = Nothing Set xlListObject = Nothing Set xlPivotCache = Nothing Set xlPivotTable = Nothing Set wsCurrent = Nothing Set xlSheet = Nothing Set xlSheetReport = Nothing Set xlBook = Nothing Set wbCurrent = Nothing Set xlApp = 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 workbook and/or the code modules (.bas files) from OneDrive.
- PushToExcel_20150516_v1.xlsm
- M_PushToExcel.bas
- M_Worksheet.bas
- M_Public.bas
- M_Pivot.bas
- M_ListObjects.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