Seamlessly update Slicer and PivotTable Cache throughout your workbook with or without using Tables. WE_PivotTable does away with the complexity of Syncing multiple PivotTables and Slicers in just one call that updates Slicers and PivotTable Caches.
AWE_PivotTable also allows you to iterate through each filtered row in your PivotTable using a callback function. This allows you to automatically filter items in your PivotTable and then perform functions like emailing portions of the PivotTable to relevant people.
The below example assumes that you already know how to use PivotTables to summarize, sort, reorganize, group, and aggregate the data stored in your spreadsheet. It also assumes that you know how to use Slicers to concurrently filter multiple pivot tables and graphs within your workbook.
Prerequisite Knowledge
Implementation
Add the below AWE_PivotTable class to your workbook (see How to Create a Class for more information). Function definitions, parameters and examples are documented in the comments before each function (see below).
'******************************************************************************************************************
'******************************************************************************************************************
'* AWE_PivotTable: Seamlessly update Slicer and PivotTable Cache throughout your workbook with or without **
'* using Tables. WE_PivotTable does away with the complexity of Syncing multiple PivotTables **
'* and Slicers in just one call that updates Slicers and PivotTable Caches. **
'* Author: Mike Libby **
'* Website: AutomationWithExcel.com **
'******************************************************************************************************************
'******************************************************************************************************************
Option Explicit
'--------------------------------------------------------------------------
'--- UpdateCaches: Update all Pivot and Slicer Caches in the Workbook ---
'--------------------------------------------------------------------------
Public Function UpdateCaches(Optional WB As Workbook = Nothing)
If WB Is Nothing Then Set WB = ThisWorkbook
Dim SlcrCache As SlicerCache, SlcrNm As String
Dim iPT As Long, PT As PivotTable, ParentPT As PivotTable, PTNm As Variant, PTCache As PivotCache, PTSheetNm As String
Dim iDict As Long
Dim SlicerArrDict As Object: Set SlicerArrDict = CreateObject("Scripting.Dictionary")
Dim SlicerPTNmDict As Object: Set SlicerPTNmDict = CreateObject("Scripting.Dictionary")
Dim iarr As Long, Arr() As Variant
Dim WS As Worksheet
'-----------------------------------------------------------------------------------
'--- Create Dictionary of Slicers whose items contain an array of PivotTables ---
'-----------------------------------------------------------------------------------
'--- Note: The parent PivotTable is the first PivotTable in the PivotTables List ---
'--- and the first array element in the PivotTable array. ---
'--- Children are any PivotTables after the fist PivotTable list and and array. ---
'-----------------------------------------------------------------------------------
For Each SlcrCache In WB.SlicerCaches
'--- Create the Slicer PivotTable Array ---
ReDim Arr(1 To SlcrCache.PivotTables.Count)
'--- Iterate each PivotTable in the Workbooks SlicerCache ---
For iPT = SlcrCache.PivotTables.Count To 1 Step -1
Set PT = SlcrCache.PivotTables(iPT)
'--- Format = SheetNm:PivotTableNm ---
PTSheetNm = PT.Parent.Name & ":" & PT.Name
'--- Build the array of PivotTables belonging to the Slicer ---
Arr(iPT) = PTSheetNm
'--- Add the Sheet and Pivot table to the Dictionary of PivotTables that belong to Slicers ---
SlicerPTNmDict(PTSheetNm) = ""
'--- Decouple child PivotTables from the Slicer ---
If iPT > 1 Then SlcrCache.PivotTables.RemovePivotTable (PT)
Next iPT
'--- Add the array of pivot tables belonging to the Slicer to SlicerArrDict.
SlicerArrDict(SlcrCache.Name) = Arr
Next SlcrCache
'-----------------------------------------------------------------------------------
'--- Update the Parent PivotTable Cache ---
'-----------------------------------------------------------------------------------
'--- Note: All child PivotTables have been decoupled from Slicers (see above). ---
'--- Only parent PivotTables remain whose cache will be updated below. ---
'-----------------------------------------------------------------------------------
For Each SlcrCache In WB.SlicerCaches
For iPT = SlcrCache.PivotTables.Count To 1 Step -1
Set PT = SlcrCache.PivotTables(iPT)
UpdatePivotCache PT, WB
Next iPT
Next SlcrCache
'-----------------------------------------------------------------------------------
'--- Copy Parent PivotTable Cache to Child PivotTables and rejoin Children to ---
'--- their Slicers. ---
'-----------------------------------------------------------------------------------
For iDict = 0 To SlicerArrDict.Count - 1
SlcrNm = SlicerArrDict.Keys()(iDict)
Arr = SlicerArrDict.Items()(iDict)
'--- Get the Slicer ---
Set SlcrCache = WB.SlicerCaches(SlcrNm)
'--- Get the Parent PivotTable ---
PTSheetNm = Split(Arr(1), ":")(0)
PTNm = Split(Arr(1), ":")(1)
Set ParentPT = WB.Sheets(PTSheetNm).PivotTables(PTNm)
'--- Copy Parent PivotTable to the Child PivotTables using the Parent PivotTable's CacheIndex ---
If UBound(Arr) >= 2 Then
For iarr = 2 To UBound(Arr)
PTSheetNm = Split(Arr(iarr), ":")(0)
PTNm = Split(Arr(iarr), ":")(1)
Set PT = WB.Sheets(PTSheetNm).PivotTables(PTNm)
PT.CacheIndex = ParentPT.CacheIndex
PT.RefreshTable
'--- Rejoin the Slicer's PivotTables ---
SlcrCache.PivotTables.AddPivotTable PT
Next iarr
End If
Next iDict
'-----------------------------------------------------------------------------------
'--- Update all non-Slicer cache ---
'-----------------------------------------------------------------------------------
'--- Note: Iterate all worksheets and update pivot table cache that is not in ---
'--- defined in the SlicerPTNmDict. ---
'-----------------------------------------------------------------------------------
For Each WS In WB.Sheets
For Each PT In WS.PivotTables
PTSheetNm = WS.Name & ":" & PT.Name
If Not SlicerPTNmDict.Exists(PTSheetNm) Then
Call UpdatePivotCache(PT, WB)
End If
Next PT
Next WS
End Function
'--------------------------------------------------------------------------
'--- UpdatePivotCache: Update a PivotTable's cache in the Workbook ---
'--------------------------------------------------------------------------
Public Function UpdatePivotCache(PT As PivotTable, Optional WB As Workbook = Nothing)
If WB Is Nothing Then Set WB = ThisWorkbook
Dim WS As Worksheet
'--- Sheets ---
Dim sheetnm As String, LastRow As Long, strRng As String, SrcRng As Range
With PT
If InStr(PT.SourceData, "!") > 0 Then
sheetnm = Left(PT.SourceData, InStr(PT.SourceData, "!") - 1)
Set WS = WB.Sheets(sheetnm)
LastRow = GetLastRow(WS)
strRng = Application.ConvertFormula(PT.SourceData, xlR1C1, xlA1)
strRng = Left(strRng, InStrRev(strRng, "$")) & CStr(LastRow)
.ChangePivotCache WB.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=WS.Range(strRng) _
)
End If
.RefreshTable
.SaveData = True
.Update
End With
End Function
'--------------------------------------------------------------------------
'--- ClearSlicerFilters: Clear all Slicer Filters in the Workbook ---
'--------------------------------------------------------------------------
Public Function ClearSlicerFilters(Optional WB As Workbook = Nothing)
If WB Is Nothing Then Set WB = ThisWorkbook
Dim SlcrCache As SlicerCache
For Each SlcrCache In WB.SlicerCaches
If SlcrCache.FilterCleared = False Then SlcrCache.ClearManualFilter
Next SlcrCache
End Function
'--------------------------------------------------------------------------
'--- UnlockSlicers: Unlock all Slicers in the Workbook ---
'--------------------------------------------------------------------------
Public Function UnlockSlicers(Optional WB As Workbook = Nothing)
If WB Is Nothing Then Set WB = ThisWorkbook
Dim SC As SlicerCache, SLCR As Slicer
For Each SC In WB.SlicerCaches
For Each SLCR In SC.Slicers
SLCR.Locked = False
Next SLCR
Next SC
End Function
'--------------------------------------------------------------------------
'--- ForEachPivotTableFilterItem: Perform the following:
'--- 1) Filter the PivotTable
'--- 2) Iterate each row
'--- 3) Perform a callback
'--------------------------------------------------------------------------
Public Function ForEachPivotTableFilterItem(PT As PivotTable, CallBackFunc As String, ColNmToFilter As String)
Dim PF As PivotField: Set PF = PT.PivotFields(ColNmToFilter)
Dim PI As PivotItem, PI2 As PivotItem, PR As Range
Dim WS As Worksheet: Set WS = PT.Parent
Dim FilterVal As Variant, FilterVals As String
Dim iPI As Long
'--- Get an array of unique filtered items ---
Dim Arr() As Variant: Arr = GetPivotFilterValues(PT, ColNmToFilter)
'--- Iterate through each unique filtered item and perform the callback function ---
For Each FilterVal In Arr
PivotTableFilterBy PT, ColNmToFilter, CStr(FilterVal), True
If PT.DataBodyRange.Rows.Count >= 2 Then
If FilterVals <> "" Then FilterVals = FilterVals & ";"
FilterVals = FilterVals & CStr(FilterVal)
Application.Run CallBackFunc, PT
End If
Next FilterVal
'--- Reset the original filtered values ---
PF.ClearAllFilters
On Error Resume Next
With PT.PivotFields(ColNmToFilter)
For iPI = 1 To .PivotItems.Count
.PivotItems(iPI).Visible = False
For Each FilterVal In Arr
If .PivotItems(iPI) = FilterVal Then .PivotItems(iPI).Visible = True
Next FilterVal
Next iPI
End With
On Error GoTo 0
End Function
'--------------------------------------------------------------------------
'--- GetPivotFilterValues: Return an array of Pivot Filers and Values ---
'--------------------------------------------------------------------------
Public Function GetPivotFilterValues(PT As PivotTable, ColNmToFilter As String) As Variant
Dim PF As PivotField: Set PF = PT.PivotFields(ColNmToFilter)
Dim VisPIs As PivotItems: Set VisPIs = PF.VisibleItems
Dim VisPI As PivotItem, PR As Range
Dim WS As Worksheet: Set WS = PT.Parent
Dim Arr() As Variant, iarr As Long
'--- Return empty array if there are no visible items ---
If VisPIs.Count = 0 Then
GetPivotFilterValues = Array()
Else
ReDim Arr(VisPIs.Count - 1)
For iarr = 0 To VisPIs.Count - 1
Set VisPI = VisPIs(iarr + 1)
Arr(iarr) = VisPI.Value
Next iarr
GetPivotFilterValues = Arr
End If
End Function
'--------------------------------------------------------------------------
'--- PivotTableFilterBy: Filter a PivotTable ---
'--------------------------------------------------------------------------
Public Function PivotTableFilterBy(PT As PivotTable, ColNmToFilter As String, FilterValue As String, Optional ClearFilters As Boolean = True)
Dim PF As PivotField, PI As PivotItem, PI2 As PivotItem, PR As Range
Dim WS As Worksheet: Set WS = PT.Parent
Set PF = PT.PivotFields(ColNmToFilter)
If ClearFilters = True Then PF.ClearAllFilters
PF.PivotFilters.Add2 xlCaptionEquals, , FilterValue
End Function
'--------------------------------------------------------------------------
'--- SlicerFilterBy: Filter a Slicer ---
'--------------------------------------------------------------------------
Public Function SlicerFilterBy(SlcrCacheNm As String, FilterValue As String, Optional WB As Workbook = Nothing)
If WB Is Nothing Then Set WB = ThisWorkbook
Dim SC As SlicerCache: Set SC = WB.SlicerCaches(SlcrCacheNm)
Dim SI As SlicerItem
SC.ClearAllFilters
For Each SI In SC.SlicerItems
If SI.Caption = FilterValue Then
SI.Selected = True
Else
SI.Selected = False
End If
Next SI
End Function
'--------------------------------------------------------------------------
'--- PivotTableRange: Retrieve the range of the Pivot Table including ---
'--- columns to the right of the Pivot Table. ---
'--------------------------------------------------------------------------
Public Function PivotTableRange(PT As PivotTable) As Range
Dim WS As Worksheet: Set WS = PT.Parent
Dim FrAddr As String: FrAddr = Split(PT.TableRange1.Address, ":")(0)
Dim FrRow As Long: FrRow = CLng(Split(FrAddr, "$")(2))
Dim FrCol As Long: FrCol = PT.TableRange1.Column
Dim ToAddr As String: ToAddr = Split(PT.TableRange1.Address, ":")(1)
Dim ToRow As Long: ToRow = CLng(Split(ToAddr, "$")(2))
Dim ToCol As Long: ToCol = WS.UsedRange.Columns.Count
Set PivotTableRange = WS.Range(FrAddr, WS.Cells(ToRow, ToCol))
End Function
'--------------------------------------------------------------------------
'--- PivotTableHdrRange: Retrieve the Pivot Table's header range ---
'--- including columns to the right of the ---
'--- PivotTable. ---
'--------------------------------------------------------------------------
Public Function PivotTableHdrRange(PT As PivotTable) As Range
Dim WS As Worksheet: Set WS = PT.Parent
Dim FrAddr As String: FrAddr = Split(PT.TableRange1.Address, ":")(0)
Dim FrRow As Long: FrRow = CLng(Split(FrAddr, "$")(2))
Dim FrCol As Long: FrCol = PT.TableRange1.Column
Dim ToAddr As String: ToAddr = Split(PT.TableRange1.Address, ":")(1)
Dim ToRow As Long: ToRow = CLng(Split(ToAddr, "$")(2))
Dim ToCol As Long: ToCol = WS.UsedRange.Columns.Count
Set PivotTableHdrRange = WS.Range(WS.Cells(FrRow, FrCol), WS.Cells(FrRow, ToCol))
End Function
'--------------------------------------------------------------------------
'--- PivotTableLastRow: Retrieve the Pivot Table's last row ---
'--------------------------------------------------------------------------
Public Function PivotTableLastRow(PT As PivotTable) As Long
With PT.TableRange2
PivotTableLastRow = .Rows(.Rows.Count).Row
End With
End Function
'--------------------------------------------------------------------------
'--- PivotTableFirstRow: Retrieve the Pivot Table's first row ---
'--------------------------------------------------------------------------
Public Function PivotTableFirstRow(PT As PivotTable) As Long
Dim FrAddr As String: FrAddr = Split(PT.TableRange1.Address, ":")(0)
PivotTableFirstRow = CLng(Split(FrAddr, "$")(2)) + 1
End Function
'--------------------------------------------------------------------------
'--- PivotTableHdrRow: Retrieve the Pivot Table's HdrRow ---
'--------------------------------------------------------------------------
Public Function PivotTableHdrRow(PT As PivotTable) As Long
Dim FrAddr As String: FrAddr = Split(PT.TableRange1.Address, ":")(0)
PivotTableHdrRow = CLng(Split(FrAddr, "$")(2))
End Function
'--------------------------------------------------------------------------
'--- PivotTableLastCol: Retrieve the Pivot Table's LastRow ---
'--------------------------------------------------------------------------
Public Function PivotTableLastCol(PT As PivotTable, Optional IsExtended As Boolean = False) As Long
PivotTableLastCol = PivotTableRange(PT).Columns.Count
End Function
'--------------------------------------------------------------------------
'--- GetLastRow: Get the last row for the worksheet ---
'--------------------------------------------------------------------------
Private Function GetLastRow(WS As Worksheet) As Long
GetLastRow = WS.UsedRange.Rows.Count
End Function
'--------------------------------------------------------------------------
'--- GetLastCol: Get the last column for the worksheet ---
'--------------------------------------------------------------------------
Private Function GetLastCol(WS As Worksheet) As Long
GetLastCol = WS.UsedRange.Columns.Count
End Function
AWE_PivotTable Examples
Update All Pivot Tables and Slicers in a Workbook
Sub btnRefreshPivotTables_Click()
Dim AWE_PT As New AWE_Pivot
AWE_PT.UpdateCaches
End Sub
Perform a Callback for Each Filter Item
Public Sub btnRevDetails_Click()
Dim WS As New Worksheet: Set WS = ThisWorkbook.Sheets("Dashboard")
Dim AWE_PT As New AWE_Pivot
Dim PT As PivotTable: Set PT = WS.PivotTables("PT_Employees")
AWE_PT.ForEachPivotTableFilterItem PT, "Sheet3.RevDetail_Callback", "Employee Name"
End Sub
Public Sub RevDetail_Callback(PT As PivotTable)
Dim PFs As PivotFields, PF As PivotField, EmpNm As String, TotalRev As String
With PT
EmpNm = .TableRange1.Cells(2, .PivotFields("Employee Name").Position).Value
Debug.Print "Employee Name: " & EmpNm
Debug.Print "Entire Pivot Table:" & .TableRange1.Address
Debug.Print "-----------------------------------"
End With
End Sub
Quick Guide
| Function | Example |
|---|---|
| Declare | Dim AWE_PT as new AWE_PivotTable |
| Update All PivotTables in a Workbook | AWE_PT.UpdateCaches |
| Perform a Callback Function For Each Filtered Item in the PivotTable |
Dim WS As Worksheet: Set WS = ThisWorkbook.Sheets("Sheet1") Dim PT As PivotTable: Set PT = WS.PivotTables("PT_Employees") AWE_PT.ForEachPivotTableFilterItem PT, "Sheet1.CallbackFunc", "FilteredColNm" Public Sub CallbackFunc (PT As PivotTable) With PT EmpNm = .TableRange1.Cells(2, .PivotFields("FilteredColNm ").Position).Value Debug.Print "Employee Name: " & EmpNm Debug.Print "Entire Pivot Table:" & .TableRange1.Address Debug.Print "-----------------------------------" End With End Sub |
Download the Example Workbook
Dashboard Sheet – Shows how to refresh Pivot Tables in the Workbook and perform Callbacks for each filtered item in the Pivot Table.
Timecard Sheet – Allows you to create test data (up to 10,000 rows) for the Dashboard Sheet.
Add comment
Comments