Fillter the pivot table with the array of values using VBA

[Vignesh N]

I want a code to filter out the pivot table based on the array of values in the <code>array(ArrDateFilter)</code> for each pivot table in the sheet called analysis.


For eg: If the array has 1/11/2016 and 1/12/2016 then Pivot field(visited_date) should filter both the values. <code>(enablemultiplepageitems = true)</code>


I have tried the below code but its keep on running. Please help me to find a simple way of coding. Attached code

<code>Sub RefreshData()
'
Dim sht As Worksheet
Dim pvt As PivotTable
Dim StartPoint As Range
Dim Rng As Range
Dim SourceAddress As String

On Error Resume Next
    ActiveSheet.ShowAllData
'Enter Worksheet Name that holds your Pivot data source
  Set sht = ActiveWorkbook.Worksheets("Raw Data")

'Enter first cell in your Pivot data source
  Set StartPoint = sht.Range("B3")

'Create SourceData address
  Set Rng = sht.Range(StartPoint, StartPoint.SpecialCells(xlLastCell))
  SourceAddress = sht.Name & "!" & Rng.Address(ReferenceStyle:=xlR1C1)

'Loop through and update pivot tables with new data source range
  For Each sht In ThisWorkbook.Worksheets
    For Each pvt In sht.PivotTables
      
      'Change Pivot Table's data source range address
        pvt.ChangePivotCache _
          ThisWorkbook.PivotCaches.Create( _
          SourceType:=xlDatabase, _
          SourceData:=SourceAddress)
        
      'Ensure Pivot Table is refreshed
        pvt.RefreshTable
        
    Next pvt
  Next sht

'Completion Message
  'MsgBox "All Pivot Table Data Source Ranges have been updated in this workbook!", vbInformation

' RefreshData Macro
On Error Resume Next
    ActiveSheet.ShowAllData
    Dim iTotRows As Integer
    iTotRows = Sheets("Raw Data").UsedRange.Rows.Count
    'MsgBox iTotRows
    
    Dim FilterSite As String
    FilterSite = Sheets("Raw Data").Cells(2, 2)
    
    Dim FilterFrom As Date
    Dim FilterTo As Date
    
    FilterFrom = Sheets("Raw Data").Cells(2, 3)
    FilterTo = Sheets("Raw Data").Cells(2, 4)
    
    Dim iLoop, iTotFilters As Integer
    Dim LoopDate As Date
    
    'MsgBox FilterFrom
    'MsgBox FilterTo
        
    '------------------------------------------- Refreshing the pivot filters -----------------------------------------'
    
    Sheets("FiltersPicklist").PivotTables("PivFilterSite").PivotCache.Refresh
    Sheets("FiltersPicklist").PivotTables("PivFilterDate").PivotCache.Refresh
    
    
    '------------------------------------------- Filtering Raw Data Sheet -----------------------------------------'
    
    If Trim(FilterSite) <> "" Then
        Sheets("Raw Data").Select
        ActiveSheet.Range("$A$3:$J$" & CStr(iTotRows)).AutoFilter Field:=2, Criteria1:=Trim(FilterSite)
    Else
        Sheets("Raw Data").Select
        ActiveSheet.Range("$A$3:$J$" & CStr(iTotRows)).AutoFilter Field:=2
    End If


    '------------------------------------------- Filtering Analysis Data Sheet -----------------------------------------'

    Dim Pt As PivotTable

    If Trim(FilterSite) <> "" Then
    
    For Each Pt In ActiveWorkbook.Worksheets("analysis").PivotTables
    Set Field = Pt.PivotFields("Site_Name")
 
'This updates and refreshes the PIVOT table
With Pt
Field.CurrentPage = FilterSite
Pt.RefreshTable

End With
Next Pt
        'ActiveSheet.PivotTables("pivOrganization").PivotFields("Site_Name").ClearAllFilters
        'ActiveSheet.PivotTables("pivOrganization").PivotFields("Site_Name").CurrentPage = FilterSite
        
        'ActiveSheet.PivotTables("pivWebsite").PivotFields("Site_Name").ClearAllFilters
        'ActiveSheet.PivotTables("pivWebsite").PivotFields("Site_Name").CurrentPage = FilterSite
        
        'ActiveSheet.PivotTables("pivIPAddress").PivotFields("Site_Name").ClearAllFilters
        'ActiveSheet.PivotTables("pivIPAddress").PivotFields("Site_Name").CurrentPage = FilterSite
        
        'ActiveSheet.PivotTables("pivCountry").PivotFields("Site_Name").ClearAllFilters
        'ActiveSheet.PivotTables("pivCountry").PivotFields("Site_Name").CurrentPage = FilterSite
    Else
        ActiveSheet.PivotTables("pivOrganization").PivotFields("Site_Name").ClearAllFilters
        ActiveSheet.PivotTables("pivWebsite").PivotFields("Site_Name").ClearAllFilters
        ActiveSheet.PivotTables("pivIPAddress").PivotFields("Site_Name").ClearAllFilters
        ActiveSheet.PivotTables("pivCountry").PivotFields("Site_Name").ClearAllFilters
    
        ActiveSheet.PivotTables("pivOrganization").PivotCache.Refresh
        ActiveSheet.PivotTables("pivWebsite").PivotCache.Refresh
        ActiveSheet.PivotTables("pivIPAddress").PivotCache.Refresh
       ActiveSheet.PivotTables("pivCountry").PivotCache.Refresh
    End If
    
Test:
    Sheets("Raw Data").Select
    
    Sheets("FiltersPicklist").Select
    iTotFilters = ActiveSheet.UsedRange.Rows.Count
    
    Dim ArrDateFilter(1 To 4000) As String
    Dim ArrIndex As Integer
    ArrIndex = 1
    
    For i = 1 To iTotFilters
        If Trim(ActiveSheet.Cells(i, 2)) <> "" And IsDate(Trim(ActiveSheet.Cells(i, 2))) Then
            LoopDate = CDate(ActiveSheet.Cells(i, 2))
            If LoopDate >= FilterFrom And LoopDate <= FilterTo Then
                ArrDateFilter(ArrIndex) = CStr(Format(LoopDate, "m/dd/yyyy hh:mm"))
                ArrIndex = ArrIndex + 1
            End If
        End If
    Next i

    'ArrDateFilter(1) = "1/19/16 22:55"   '01/05/2016 4:00:00 PM
    'ArrDateFilter(2) = "1/22/16 12:38"   '"1/29/16 13:13"
    
    Sheets("Raw Data").Select
    ActiveSheet.Range("$A$3:$J$4000").AutoFilter Field:=4, Criteria1:=ArrDateFilter, Operator:=xlFilterValues

' this is where I have problem in filtering the multiple values in pivot filter

For Each Pt In ActiveWorkbook.Worksheets("analysis").PivotTables
Set Field = Pt.PivotFields("Visited_Date")
For i = 1 To LBound(ArrDateFilter)
With Pt
Field.EnableMultiplePageItems = True
Field.CurrentPage = ArrDateFilter(ArrIndex)
ArrIndex = ArrIndex + 1
Pt.RefreshTable
End With
Next i
Next Pt

End sub
</code>