Filter Pivot Table Source Data
Filter Pivot Table Source Data II
I call my filtering code from two separate places. First, if a cell in a pivot table is double clicked, the code is called. My code is in an add-in, not in the workbook that contains the pivot table, so I have to set up an application-level event handler to capture the double click. I have a class module called CAppEvents that looks like this.
Public Property Set App(xlApp As Application)
Set mxlApp = xlApp
End Property
Private Sub mxlApp_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim pt As PivotTable
On Error Resume Next
Set pt = Target.PivotTable
On Error GoTo 0
If Not pt Is Nothing Then
If pt.PivotCache.SourceType = xlDatabase Then
If Not Intersect(Target, pt.DataBodyRange) Is Nothing Then
Cancel = True
FilterPivotSource Target, pt
End If
End If
End If
End Sub
In the variable declaration, I use the WithEvents keyword to expose my Application variable’s events. Then I can use the SheetBeforeDoubleClick event code to do some error checking and call the code.
My first test is to make sure the cell is inside a pivot table. I try to set the pt variable, then check to see if it’s Nothing. If it’s not, I know I’m good to go. The second test is of the SourceType of the PivotCache. I’m only concerned with pivot tables that use Excel data as the source, not external data or OLAP cubes or anything like that.
The last test is whether the cell is in the DataBodyRange. If it’s not, the cell would represent one of the filters (column, row, or page) and I only want cells that represents data that has been filtered, not the filters themselves.
If all my tests pass, I cancel the normal double click action (which is creating a new sheet with the filtered data on it) and call my main procedure.
To get the events to fire, you need a global variable (never loses scope) for the CAppEvents class. In the declarations section of a standard module
Then, also in a standard module
Set gclsAppEvents = New CAppEvents
Set gclsAppEvents.App = Application
End Sub
Because I’m a keyboard freak, I prefer to select a cell in the pivot table and select a menu item rather than double click. I have this alternate entry point procedure to do that.
Dim pt As PivotTable
On Error Resume Next
Set pt = ActiveCell.PivotTable
On Error GoTo 0
If Not pt Is Nothing Then
If pt.PivotCache.SourceType = xlDatabase Then
If Not Intersect(ActiveCell, pt.DataBodyRange) Is Nothing Then
FilterPivotSource ActiveCell, pt
End If
End If
End If
End Sub
It does all the same things except that it uses the ActiveCell rather than the Target.
Posting code? Use <pre> tags for VBA and <code> tags for inline.