Update Pivot Filters from Cell Values

[wsnyder]

Hi all,

Trying to update Pivot Filters from Cell Values.
Everything seems like it should work.
I set watches and values are as expected from cell values.

However, when code completes, PivotFilters still show as all
Any ideas what I am missing?

Thanks,
w

Option Explicit

Sub FilterPivotTables()


    Dim wb As Workbook
    Dim wsWorking As Worksheet
    Dim pt As PivotTable
    Dim rngDates As Range
    Dim rngChannel As Range
    Dim pfDates As PivotField
    Dim pfChannel As PivotField
    Dim DatesArr As Variant
    Dim i As Integer    'PivotItem Count
    Dim j As Integer    'Filter criteria count
    Dim ChannelName As String
    
    Set wb = ThisWorkbook
    Set wsWorking = wb.Worksheets("Working")
    With wsWorking
        Set rngDates = .Range(.Cells(3, 2), .Cells(5, 2))
        Set rngChannel = .Cells(7, 2)
    End With
    
    
    'Load date range into an array
        DatesArr = Application.Transpose(rngDates)
        
    'Channel name in scope
        ChannelName = CStr(rngChannel.Value)
        Debug.Print "ChannelName:"; ChannelName
        Debug.Print "Sheet for Pivot: "; wsPivotPrior.Name
 
    'Clear existing pivot filters
        With wsPivotPrior
            For Each pt In .PivotTables
                
                'Pivot Fields
                    Set pfDates = pt.PivotFields("[03 Central Date Table].[EDATE].[EDATE]")
                    Set pfChannel = pt.PivotFields("[DDim - Revenue Channel].[REVENUE_CHANNEL].[REVENUE_CHANNEL]")
                
                'Clear existing criteria
                    pt.ClearAllFilters
                    
                'Update date filter
                    With pfDates
                        For i = 1 To pfDates.PivotItems.Count
                            j = 1
                            Do While j <= UBound(DatesArr) - LBound(DatesArr) + 1
                                If pfDates.PivotItems(i).Name = DatesArr(j) Then
                                    pfDates.PivotItems(pfDates.PivotItems(i).Name).Visible = True
                                    Exit Do
                                Else
                                    pfDates.PivotItems(pfDates.PivotItems(i).Name).Visible = False
                                End If
                                j = j + 1
                            Loop
                        Next i
                    End With
                
                'Update channel filter
                    With pfChannel
                        For i = 1 To pfChannel.PivotItems.Count
                            If pfChannel.PivotItems(i).Name = ChannelName Then
                                pfChannel.PivotItems(pfChannel.PivotItems(i).Name).Visible = True
                            Else
                                pfChannel.PivotItems(pfChannel.PivotItems(i).Name).Visible = False
                            End If
                        Next i
                    End With


                'Tidy up
                    Set pfDates = Nothing
                    Set pfChannel = Nothing
            Next pt
    End With
    
    'Tidy up
        Erase DatesArr
        Set rngDates = Nothing
        Set rngChannel = Nothing
        Set wsWorking = Nothing
        Set wb = Nothing
        
End Sub

 

[DanteAmor]

Check the following thread:

VBA for Pivot to filter on cell value not working

Hello All, I am trying to apply below VBA code to a pivot to filter based on cell range. But I am getting error 400. Sub OAL() Dim filtvalues As Variant Dim i As Integer, j As Integer Dim pvt As PivotField Dim pitm As PivotItem filtvalues = Sheets("Pivot").Range("A1:A2") Set pvt =...

www.mrexcel.com