Search Contextures Sites

Excel Pivot Tables -- Filter Source Data

Add the Source Data Filter Code
Add the Event Code
Pivot Table Tutorials

When you double-click a data cell in an Excel pivot table, a new worksheet is created, with the related records from the source data. If you do this frequently, you'll end up with many extra sheets in your workbook, and will need to delete all the excess sheets.

Download the zipped Filter Excel Pivot Table Source Data sample file with code shown below, or the zipped Filter Excel Pivot Table Source Data sample file - Short with a shorter version of the code.

If your Excel pivot table source data is a list in the same workbook as the Excel pivot table, you can use the following macro, written by Héctor Miguel Orozco Díaz. It applies a filter to the source data, based on the pivot items connected to the double-clicked cell.

For example, when you double-click the cell circled in screenshot below:

The source data is filtered for Class_A, Month_3, Store_1, Code_A cost.

 

Add the Source Data Filter Code

The following code filters the Excel pivot table source data if a data cell in the pivot table was double clicked. In there Excel 2007 there are some issues if (All) is the current selection in a Report Filter, so the code addresses that situation.

Store this code in a regular code module.

 

Private Function Slice(Which As Range, Where As Range) As Range
' written by Héctor Miguel Orozco Díaz
' http://www.contextures.com/xlPivot-Filter-Source-Data.html
' === general function for "divorcing" ranges (the opposite of Union) ===
  Dim xCell As Range
  For Each xCell In Where
    If Intersect(xCell, Which) Is Nothing Then
      Set Slice = Union(IIf(Slice Is Nothing, xCell, Slice), xCell)
    End If
  Next
End Function

'===================================================================

Sub PTCellFilterExcelDataSource()
' written by Héctor Miguel Orozco Díaz
' === and the procedure (modified due to 2007 language issue) ===
  Application.ScreenUpdating = False
  With ActiveSheet
    If .PivotTables.Count = 0 Then
      Exit Sub
    End If
    Dim pt As Byte, Go4It As Boolean, rowL As String
    For pt = 1 To .PivotTables.Count
      If Not Intersect(ActiveCell, .PivotTables(pt).DataBodyRange) Is Nothing Then
        Go4It = True
        Exit For
      End If
    Next
    If Not Go4It Then
      Exit Sub
    End If
    rowL = Application.International(xlUpperCaseRowLetter)
    Dim srcData As String, xSht As String, xRng As String
    Dim srcTitles As String, cpFilter As String
    Dim Partial As Byte, Totals As Byte, Zone As Byte, nXT As Integer, nXT2 As Integer
    Dim pgFlds As Integer, colFlds As Integer, lblFlds As Integer, rowFlds As Integer
    Dim dataFlds As Integer, nRows As Integer, nCols As Integer
    Dim pTFld As PivotField, dataCols As Range, colsP As Range
    Dim rowsF As Range, rowsD As Range, xCell As Range, cellsD As Range
    Dim cellsPC As Range, cellsPR As Range, cellsPX As Range
    Dim cellsTC As Range, cellsTR As Range, cellsTCX As Range, cellsTRX As Range
    With .PivotTables(pt)
      srcData = .PivotCache.SourceData
      xSht = IIf(InStr(srcData, "!") > 0, Application.Substitute(Left(srcData, _
        InStr(srcData, "!") - 1), "'", ""), .Parent.Name)
      With Application
        xRng = .ConvertFormula(.Substitute(Mid(srcData, InStr(srcData, "!") + 1), _
          rowL, "R"), xlR1C1, xlA1)
      End With
      srcTitles = Range(xRng).Resize(1).Address
      pgFlds = .PageFields.Count
      colFlds = .ColumnFields.Count
      lblFlds = .DataLabelRange.Columns.Count
      rowFlds = .RowFields.Count - lblFlds
      dataFlds = .DataFields.Count
      If rowFlds > 1 Then
        Partial = 1
      End If
      If colFlds > 1 Then
        Partial = Partial + 2
      End If
      If .RowGrand Then
        Totals = 1
      End If
      If .ColumnGrand Then
        Totals = Totals + 2
      End If
      With .ColumnRange
        For Each xCell In .Offset(.Rows.Count - 1).Resize(1, .Columns.Count + (Totals > 1))
          If Application.CountIf(Worksheets(xSht).Range(xRng), xCell) > 0 Then
            Set dataCols = Union(IIf(dataCols Is Nothing, xCell, dataCols), xCell)
          Else
            Set colsP = Union(IIf(colsP Is Nothing, xCell, colsP), xCell)
          End If
        Next
      End With
      For Each pTFld In .DataFields
        Set rowsD = Union(pTFld.DataRange.EntireRow, _
            IIf(rowsD Is Nothing, pTFld.DataRange.EntireRow, rowsD))
      Next
      With .RowRange
        Set rowsF = Intersect(rowsD, .Resize(, .Columns.Count - lblFlds))
      End With
      Set cellsD = Intersect(rowsD, dataCols.EntireColumn)
      If Partial > 1 Then
        Set cellsPC = Intersect(rowsD, colsP.EntireColumn)
      End If
      With .DataBodyRange.Resize(.DataBodyRange.Rows.Count + ((Totals \ 2 = 1) * dataFlds))
        If Partial \ 2 = 1 Then
          Set cellsPR = Slice(cellsD, Intersect(.EntireRow, dataCols.EntireColumn))
        End If
        If Partial = 3 Then
          Set cellsPX = Slice(cellsPC, Intersect(.EntireRow, colsP.EntireColumn))
        End If
      End With
      If Totals > 1 Then
        Set cellsTC = Intersect(rowsD, .ColumnRange.Offset _
          (.ColumnRange.Rows.Count - 1, _
            .ColumnRange.Columns.Count - 1).Resize(1, 1).EntireColumn)
      End If
      If Totals \ 2 = 1 Then
        Set cellsTR = Intersect(.DataBodyRange.Offset _
          (.DataBodyRange.Rows.Count - dataFlds).Resize(dataFlds), _
             dataCols.EntireColumn)
      End If
      If Totals = 3 Then
        If Not cellsPR Is Nothing Then
          Set cellsTCX = Intersect(cellsPR.EntireRow, cellsTC.EntireColumn)
        End If
      End If
      If Totals = 3 Then
        If Not cellsPC Is Nothing Then
          Set cellsTRX = Intersect(cellsTR.EntireRow, cellsPC.EntireColumn)
        End If
      End If
      If Not Intersect(ActiveCell, cellsD) Is Nothing Then
        Zone = 1
      End If
      If Not cellsPC Is Nothing Then
        If Not Intersect(ActiveCell, cellsPC) Is Nothing Then
          Zone = 2
        End If
      End If
      If Not cellsPR Is Nothing Then
        If Not Intersect(ActiveCell, cellsPR) Is Nothing Then
          Zone = 3
        End If
      End If
      If Not cellsPX Is Nothing Then
        If Not Intersect(ActiveCell, cellsPX) Is Nothing Then
          Zone = 4
        End If
      End If
      If Not cellsTC Is Nothing Then
        If Not Intersect(ActiveCell, cellsTC) Is Nothing Then
          Zone = 5
        End If
      End If
      If Not cellsTR Is Nothing Then
        If Not Intersect(ActiveCell, cellsTR) Is Nothing Then
          Zone = 6
        End If
      End If
      If Not cellsTCX Is Nothing Then
        If Not Intersect(ActiveCell, cellsTCX) Is Nothing Then
          Zone = 7
        End If
      End If
      If Not cellsTRX Is Nothing Then
        If Not Intersect(ActiveCell, cellsTRX) Is Nothing Then
          Zone = 8
        End If
      End If
      If Not cellsTR Is Nothing And Not cellsTC Is Nothing Then
        If Not Intersect(ActiveCell, cellsTR.EntireRow, cellsTC.EntireColumn) Is Nothing Then
          MsgBox "ActiveCell is @ the Bottom-Right End of Pivot Table !!!"
          GoTo Done ' Zone = 9 '
        End If
      End If
      If Worksheets(xSht).AutoFilterMode Then
        Worksheets(xSht).AutoFilterMode = False
      End If
      If pgFlds = 0 Then
        GoTo NoPages
      End If
      For nXT = 1 To pgFlds
        With .PageFields(nXT)
          cpFilter = .CurrentPage
          If Val(Application.Version) < 12 Then
            GoTo SkipLoop
          Else
            cpFilter = "(All)"
          End If
          For nXT2 = 1 To .PivotItems.Count
            If .CurrentPage = .PivotItems(nXT2) Then
              cpFilter = .PivotItems(nXT2)
              Exit For
            End If
          Next
SkipLoop:
          If cpFilter <> "(All)" Then
            Worksheets(xSht).Range(xRng).AutoFilter Field:= _
             Application.Match(.Name, Worksheets(xSht).Range(srcTitles), 0), _
             Criteria1:=CStr(cpFilter)
          End If
        End With
      Next
NoPages:
      Select Case Zone:
        Case 1, 2, 5
          nRows = rowFlds
      End Select
      Select Case Zone
        Case 1, 3, 6
          nCols = colFlds
      End Select
      Select Case Zone
        Case 3, 4, 7
          nRows = rowFlds - 1
      End Select
      Select Case Zone
        Case 2, 4, 8
          nCols = colFlds - 1
      End Select
      For nXT = 1 To nRows
        With Cells(ActiveCell.Row, .RowRange.Cells(1).Column).Offset(, -1 + nXT)
          Worksheets(xSht).Range(xRng).AutoFilter Field:= _
            Application.Match(.PivotField.Name, Worksheets(xSht).Range(srcTitles), 0), _
            Criteria1:=.PivotItem.Name
        End With
      Next
      For nXT = 1 To nCols
        With Cells(.ColumnRange.Cells(1).Row, ActiveCell.Column).Offset(nXT)
          Worksheets(xSht).Range(xRng).AutoFilter Field:= _
            Application.Match(.PivotField.Name, Worksheets(xSht).Range(srcTitles), 0), _
            Criteria1:=.PivotItem.Name
        End With
      Next
    End With
  End With
Done:
  Set cellsTRX = Nothing
  Set cellsTCX = Nothing
  Set cellsTR = Nothing
  Set cellsTC = Nothing
  Set cellsPX = Nothing
  Set cellsPR = Nothing
  Set cellsPC = Nothing
  Set cellsD = Nothing
  Set rowsD = Nothing
  Set rowsF = Nothing
  Set colsP = Nothing
  Set dataCols = Nothing

End Sub 

 

  

 

 

   

Add the Event Code

The following code is stored in the worksheet module for the Excel pivot table worksheet. This is an event procedure that runs automatically when a cell on the worksheet is double-clicked.

To add the code:

  1. Right-click on the pivot table worksheet tab
  2. Click on View Code
  3. Paste the code where the cursor is flashing.

 

 

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
' written by Héctor Miguel Orozco Díaz
  If Target.PivotTable = PivotTables(1) Then
    Cancel = True
    PTCellFilterExcelDataSource
  End If

End Sub 

 

 

   
Download the zipped Filter Excel Pivot Table Source Data sample file with code shown below, or the zipped Filter Excel Pivot Table Source Data sample file - Short with a shorter version of the code.  
   

Pivot Table Tutorials

Pivot Table Introduction 
Clear Old Items in Pivot Table
Create a Pivot Table in Excel 2007 
Custom Calculations 
Data Field Layout
Dynamic Data Source
FAQs - Pivot Tables
Field Settings
Filter Source Data  
Filters, Top 10 
Filters, Report Filters
GetPivotData Function
Grand Totals
Grouping Data
Layout, Excel 2007
Multiple Consolidation Ranges
Pivot Cache   
PivotTable Style
Printing a Pivot Table   
Protection  
Running Totals  
Show and Hide Items 
Sorting
Subtotals 
Summary Functions
Unique Item Count

Pivot Table Books

Beginning Pivot Tables (Excel 2007) 
Pivot Tables Recipe Book (Excel 2003) 
Pivot Tables Recipe Book (Excel 2007) 

Pivot Table Add-Ins

Pivot Power 
Pivot Play PLUS 

Pivot Table Videos

Clear Old Items
Copy a Custom PivotTable Style
Create Pivot Table in Excel 2007
Create Pivot Table from Multiple Sheets
Data Field Layout
Date Filters, Add
GetPivotData
Group Data
Layout, Excel 2007
Report Filters, Add
Running Totals
Select Sections
Subtotals, Create Multiple
Top 10 Filters

Learn how to create Excel dashboards.

 

 
   

 

Privacy Policy

 

Contextures Inc., Copyright ©2013
All rights reserved.

 

Last updated: September 17, 2013 7:50 PM