Display values selected inside pivot filter

[ssubhash]

I have a pivot table with filter option. Filter has 10 different values. When I select multiple options, the filter cell shows 'multiple'. Is there a way that I can show as a list in some other column what selections are made in this filter? If it is not multiple I can simply reference to that cell and show value but if more than 1 is selected, I cannot use this technique.

Thanks,
Subhash

 

[Domenic]

The following code requires Excel 2007 or later, and has been tested on Excel 2010. It assumes that "Sheet2" contains the PivotTable, and that the PivotTable is named "PivotTable1". Change these names, accordingly.

For each PageField in the PivotTable, if multiple items have been selected, those items will be listed next to the PageField. These will be automatically updated each time the PivotTable is updated.

First, put the following code in the workbook module...

1. Open the Visual Basic Editor (Alt+F11), if it's not already opened.
2. In the Project Explorer window (Ctrl+R), double-click ThisWorkbook.
3. Copy/paste the code in workbook module.

Private Sub Workbook_Open()
    Call UpdatePrevPageRange
End Sub

Then, put the following code in a standard module...

1. Insert > Module
2. Copy/paste the code in the module.

[FONT=Courier New][COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]

[COLOR=darkblue]Public[/COLOR] PrevPageRange [COLOR=darkblue]As[/COLOR] Range


[COLOR=darkblue]Sub[/COLOR] UpdatePrevPageRange()


    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]
    [COLOR=darkblue]Set[/COLOR] PrevPageRange = Worksheets("Sheet2").PivotTables("PivotTable1").PageRange
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] 0
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
[/FONT]

Then, put the following code in the sheet module...

1. Right-click the sheet tab for "Sheet2" or whichever sheet contains the PivotTable, and select View Code.
2. Copy/paste the code in the sheet module.

[FONT=Courier New][COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]

[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] Worksheet_PivotTableUpdate([COLOR=darkblue]ByVal[/COLOR] Target [COLOR=darkblue]As[/COLOR] PivotTable)


    [COLOR=darkblue]Dim[/COLOR] colPgFlds [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]New[/COLOR] Collection
    [COLOR=darkblue]Dim[/COLOR] arrItems() [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] PgFld [COLOR=darkblue]As[/COLOR] PivotField
    [COLOR=darkblue]Dim[/COLOR] PvtItm [COLOR=darkblue]As[/COLOR] PivotItem
    [COLOR=darkblue]Dim[/COLOR] PgFldCnt [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] MaxColIndx [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] Cnt [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] j [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] PrevPageRange [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
        [COLOR=darkblue]With[/COLOR] PrevPageRange
            Me.Range(Cells(.Rows(1).Row, .Columns(.Columns.Count).Column + 1), _
                Cells(.Rows(.Rows.Count).Row, Columns.Count)).ClearContents
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    
    PgFldCnt = ActiveSheet.PivotTables("PivotTable1").PageFields.Count
    
    [COLOR=darkblue]If[/COLOR] PgFldCnt > 0 [COLOR=darkblue]Then[/COLOR]
    
        [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] PgFld [COLOR=darkblue]In[/COLOR] ActiveSheet.PivotTables("PivotTable1").PageFields
            colPgFlds.Add PgFld.Name, [COLOR=darkblue]CStr[/COLOR](PgFld.Position)
        [COLOR=darkblue]Next[/COLOR] PgFld
        
        [COLOR=darkblue]ReDim[/COLOR] arrItems(1 [COLOR=darkblue]To[/COLOR] PgFldCnt, 1 [COLOR=darkblue]To[/COLOR] 1)
        
        Cnt = 0
        MaxColIndx = 0
        [COLOR=darkblue]For[/COLOR] i = 1 [COLOR=darkblue]To[/COLOR] PgFldCnt
            [COLOR=darkblue]With[/COLOR] ActiveSheet.PivotTables("PivotTable1").PageFields(colPgFlds.Item(CStr(PgFldCnt - i + 1)))
                [COLOR=darkblue]If[/COLOR] .AllItemsVisible [COLOR=darkblue]Then[/COLOR]
                    arrItems(i, 1) = ""
                [COLOR=darkblue]Else[/COLOR]
                    [COLOR=darkblue]For[/COLOR] j = 1 [COLOR=darkblue]To[/COLOR] .PivotItems.Count
                        [COLOR=darkblue]If[/COLOR] .PivotItems(j).Visible = [COLOR=darkblue]True[/COLOR] [COLOR=darkblue]Then[/COLOR]
                            Cnt = Cnt + 1
                            [COLOR=darkblue]If[/COLOR] Cnt > MaxColIndx [COLOR=darkblue]Then[/COLOR]
                                MaxColIndx = Cnt
                                [COLOR=darkblue]ReDim[/COLOR] [COLOR=darkblue]Preserve[/COLOR] arrItems(1 [COLOR=darkblue]To[/COLOR] PgFldCnt, 1 [COLOR=darkblue]To[/COLOR] Cnt)
                            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
                            arrItems(i, Cnt) = .PivotItems(j).Name
                        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
                    [COLOR=darkblue]Next[/COLOR] j
                    [COLOR=darkblue]If[/COLOR] Cnt = 1 [COLOR=darkblue]Then[/COLOR]
                        arrItems(i, 1) = ""
                    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
                    Cnt = 0
                [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
        [COLOR=darkblue]Next[/COLOR] i
        
        [COLOR=darkblue]With[/COLOR] ActiveSheet.PivotTables("PivotTable1").PageRange
            .Offset(, .Columns.Count).Resize(UBound(arrItems, 1), UBound(arrItems, 2)).Value = arrItems
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
        
        [COLOR=darkblue]Call[/COLOR] UpdatePrevPageRange
        
    [COLOR=darkblue]Else[/COLOR]
    
        [COLOR=darkblue]Set[/COLOR] PrevPageRange = [COLOR=darkblue]Nothing[/COLOR]
    
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]


[/FONT]

Lastly, save, close, and re-open your workbook.

 

[Clive Southon]

Hi there. I hada similar challenge and have used the above code - THANK YOU. The concern I have is the code displays the each of the manual filters in a separate cell to the right of the filter. Can you assist such that that the filters are displayed in the cell IMMEDIATELY to the right of the filters and separated by commas (sorry for being fussy). Thanks in advance for your help!! Regards, Clive

 

[Domenic]

Hi there. I hada similar challenge and have used the above code - THANK YOU. The concern I have is the code displays the each of the manual filters in a separate cell to the right of the filter. Can you assist such that that the filters are displayed in the cell IMMEDIATELY to the right of the filters and separated by commas (sorry for being fussy). Thanks in advance for your help!! Regards, Clive

Try replacing the code in the sheet module with the following...

Option Explicit

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)


    Dim colPgFlds                           As New Collection
    Dim arrItems()                          As String
    Dim PT                                  As PivotTable
    Dim PgFld                               As PivotField
    Dim PgFldCnt                            As Long
    Dim PivotItemCnt                        As Long
    Dim Cnt                                 As Long
    Dim i                                   As Long
    Dim j                                   As Long
    
    If Not PrevPageRange Is Nothing Then
        With PrevPageRange
            .Offset(, .Columns.Count).Resize(, 1).ClearContents
        End With
    End If
    
    Set PT = Target
    
    PgFldCnt = PT.PageFields.Count
    
    If PgFldCnt > 0 Then
    
        For Each PgFld In PT.PageFields
            colPgFlds.Add PgFld.Name, CStr(PgFld.Position)
        Next PgFld
        
        ReDim arrItems(1 To PgFldCnt)
        
        Cnt = 0
        For i = 1 To PgFldCnt
            With PT.PageFields(colPgFlds.Item(CStr(PgFldCnt - i + 1)))
                If .EnableMultiplePageItems Then
                    If .AllItemsVisible = False Then
                        PivotItemCnt = 0
                        For j = 1 To .PivotItems.Count
                            If .PivotItems(j).Visible = True Then
                                PivotItemCnt = PivotItemCnt + 1
                                arrItems(i) = arrItems(i) & ", " & .PivotItems(j).Name
                            End If
                        Next j
                        If PivotItemCnt = 1 Then
                            arrItems(i) = ""
                        Else
                            Cnt = Cnt + 1
                            arrItems(i) = Mid(arrItems(i), 3)
                        End If
                    End If
                End If
            End With
        Next i
        
        If Cnt > 0 Then
            With PT.PageRange
                .Offset(, .Columns.Count).Resize(UBound(arrItems), 1).Value = Application.Transpose(arrItems)
            End With
        End If
        
        Call UpdatePrevPageRange
        
    Else
    
        Set PrevPageRange = Nothing
    
    End If
    
End Sub

 

[Clive Southon]

Hello Domenic, What more can I say - THANK TOU, THANK YOU, THANK YOU! Your solution works perfectly and will my make job a great deal easier. Regards, Clive

 

[Domenic]

You're very welcome! I'm glad I could help!

Cheers!