Add PivotTable filter Based on Range

B

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

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
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"


DanteAmor said:
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
Click to expand...
 
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
You must log in or register to reply here.

Similar threads

J
  • Solved
VBA/Macro: Adding Pivot table with connection string
Replies
1
Views
273
Jette3173
J
C
  • Question Question
Pivot Table VBA
Replies
0
Views
240
chaddres
C
G
  • Question Question
VBA Filter Pivot Table Question
Replies
0
Views
476
gmazza76
G
ghull99
  • Question Question
Attempting VBA to refresh "Chart Title" based on Pivot Filters. Filter1 works in VBA, but title doesn't update based on filter2.
Replies
0
Views
73
ghull99
ghull99
J
  • Question Question
How can I copy the grouping rules from one pivot table to another pivot table?
Replies
0
Views
408
jaza_tom
J

Forum statistics

Threads
1,224,823
Messages
6,181,180
Members
453,021
Latest member
Justyna P

Share this page

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