Add PivotTable filter Based on Range

breynolds0431

Active Member
Joined
Feb 15, 2013
Messages
303
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi. I have a combo box that the user selects their own name. The linked cell to the combo box is a named range. I was hoping to use that named range to apply a filter based on the name to four pivot tables. I was hoping this would do the trick, with the range set to the CurrentPage filter, but that was a no. :)

Code:
With ActiveSheet.PivotTables("PivotTable1").PivotFields("DR - L1")        
        .Orientation = xlPageField
        .Position = 1
End With
    
ActiveSheet.PivotTables("PivotTable1").PivotFields("DR - L1"). _
        CurrentPage = Sheets("dd").Range("AudSelected")
        
  
    ActiveSheet.PivotTables("PivotTable1").PivotFields("DR - L1"). _
        EnableMultiplePageItems = True
 
Last edited:

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Try this.
The code does the following, activates all the items in the field, then searches for each item within the range name, if it does not exist then it hides, that way you will only see the items that are in the range name.

Note: at least one item must remain visible, if you want to hide all, the code sends you a notice.

Code:
Sub test()
    Dim b As Range, wItem As PivotItem
    Dim n As Long, wDato As String
    
    Application.ScreenUpdating = False
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("DR - L1")
        .Orientation = xlPageField
        .Position = 1
        .EnableMultiplePageItems = True
    
        For Each wItem In .PivotItems
            .PivotItems(wItem.Value).Visible = True
        Next
        For Each wItem In .PivotItems
            Set b = Sheets("dd").Range("AudSelected").Find(wItem.Value, LookIn:=xlValues, lookat:=xlWhole)
            If b Is Nothing Then
                n = n + 1
                If n < .PivotItems.Count Then
                    .PivotItems(wItem.Value).Visible = False
                Else
                    MsgBox "No match"
                End If
            End If
        Next
    End With
  
End Sub
 
Upvote 0
That worked great! However, it stopped after PivotTable1. Is there away for it to go through and do the same for the other three PivotTables ? They are all on the same Active Sheet. I tried copying all from With to End With and updating the PivotTable numbering and PivotFields value, but it found its way to displaying the "No Match" message after only setting PivotTable1 to AudSelected.
 
Upvote 0
Missing n = 0

Code:
Sub test()    Dim b As Range, wItem As PivotItem
    Dim n As Long, wDato As String
    Dim wTable As PivotTable
    Application.ScreenUpdating = False
    
    For Each wTable In ActiveSheet.PivotTables
        With wTable.PivotFields("DR - L1")
            .Orientation = xlPageField
            .Position = 1
            .EnableMultiplePageItems = True
        
            For Each wItem In .PivotItems
                .PivotItems(wItem.Value).Visible = True
            Next
[B][COLOR=#0000ff]            n = 0[/COLOR][/B]
            For Each wItem In .PivotItems
                Set b = Sheets("dd").Range("AudSelected").Find(wItem.Value, LookIn:=xlValues, lookat:=xlWhole)
                If b Is Nothing Then
                    n = n + 1
                    If n < .PivotItems.Count Then
                        .PivotItems(wItem.Value).Visible = False
                    Else
                        MsgBox "No match"
                    End If
                End If
            Next
        End With
    Next
End Sub
 
Upvote 0
Thanks again for looking into this. However, it still stops at PivotTable1. Would the issue be that each pivot has a different PivotTable field for the filter?


For example:

PivotTable2 has filter set for Field "DR - L2"
PivotTable3 has filter set for Field "Aud - L1"
PivotTable4 ihas filter set for Field "Aud - L2"


Missing n = 0

Code:
Sub test()    Dim b As Range, wItem As PivotItem
    Dim n As Long, wDato As String
    Dim wTable As PivotTable
    Application.ScreenUpdating = False
    
    For Each wTable In ActiveSheet.PivotTables
        With wTable.PivotFields("DR - L1")
            .Orientation = xlPageField
            .Position = 1
            .EnableMultiplePageItems = True
        
            For Each wItem In .PivotItems
                .PivotItems(wItem.Value).Visible = True
            Next
[B][COLOR=#0000ff]            n = 0[/COLOR][/B]
            For Each wItem In .PivotItems
                Set b = Sheets("dd").Range("AudSelected").Find(wItem.Value, LookIn:=xlValues, lookat:=xlWhole)
                If b Is Nothing Then
                    n = n + 1
                    If n < .PivotItems.Count Then
                        .PivotItems(wItem.Value).Visible = False
                    Else
                        MsgBox "No match"
                    End If
                End If
            Next
        End With
    Next
End Sub
 
Upvote 0
update this:


Code:
Sub test()
    Dim b As Range, wItem As PivotItem
    Dim n As Long, wDato As String
    
    Application.ScreenUpdating = False
    [COLOR=#0000ff]n = 0[/COLOR]
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("DR - L1")
        .Orientation = xlPageField
        .Position = 1
        .EnableMultiplePageItems = True
    
        For Each wItem In .PivotItems
            .PivotItems(wItem.Value).Visible = True
        Next
        For Each wItem In .PivotItems
            Set b = Sheets("dd").Range("AudSelected").Find(wItem.Value, LookIn:=xlValues, lookat:=xlWhole)
            If b Is Nothing Then
                n = n + 1
                If n < .PivotItems.Count Then
                    .PivotItems(wItem.Value).Visible = False
                Else
                    MsgBox "No match"
                End If
            End If
        Next
    End With
  
    [COLOR=#0000FF]n = 0[/COLOR]
    With ActiveSheet.PivotTables("PivotTable[COLOR=#ff0000]2[/COLOR]").PivotFields("[COLOR=#ff0000]DR - L2[/COLOR]")
        .Orientation = xlPageField
        .Position = 1
        .EnableMultiplePageItems = True
    
        For Each wItem In .PivotItems
            .PivotItems(wItem.Value).Visible = True
        Next
        For Each wItem In .PivotItems
            Set b = Sheets("dd").Range("AudSelected").Find(wItem.Value, LookIn:=xlValues, lookat:=xlWhole)
            If b Is Nothing Then
                n = n + 1
                If n < .PivotItems.Count Then
                    .PivotItems(wItem.Value).Visible = False
                Else
                    MsgBox "No match"
                End If
            End If
        Next
    End With

    [COLOR=#0000FF]n = 0[/COLOR]
    With ActiveSheet.PivotTables("PivotTable[COLOR=#ff0000]3[/COLOR]").PivotFields("[COLOR=#ff0000]Aud - L1[/COLOR]")
        .Orientation = xlPageField
        .Position = 1
        .EnableMultiplePageItems = True
    
        For Each wItem In .PivotItems
            .PivotItems(wItem.Value).Visible = True
        Next
        For Each wItem In .PivotItems
            Set b = Sheets("dd").Range("AudSelected").Find(wItem.Value, LookIn:=xlValues, lookat:=xlWhole)
            If b Is Nothing Then
                n = n + 1
                If n < .PivotItems.Count Then
                    .PivotItems(wItem.Value).Visible = False
                Else
                    MsgBox "No match"
                End If
            End If
        Next
    End With

End Sub
 
Last edited:
Upvote 0
I found something

You can change this

Code:
        For Each wItem In .PivotItems            
              .PivotItems(wItem.Value).Visible = True
        Next


By

Code:
.[COLOR=#0000ff]ClearAllFilters[/COLOR]
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,893
Messages
6,175,239
Members
452,621
Latest member
Laura_PinksBTHFT

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top