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
That looks better.
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
