VBA filtering dates - vba

Question

This is my function, the code stops on the line "If pitem.visible=True" on the first iteration (line 17). While the code is running, I always have visible items int the field.
The code is not even setting any property to visible and it's working very well if I filter anything other than a date.
Function tableau()
Dim fld As PivotField
Dim pitem As PivotItem
Dim i As Long
Dim arr() As Variant
Dim a As String
Dim pvt As String
pvt = "PivotTable"
Sheets("Données").ListObjects("table1").AutoFilter.ShowAllData
Sheets("PivotTableSheet").Activate
Sheets("PivotTableSheet").PivotTables(pvt).ManualUpdate = True
Sheets("PivotTableSheet").PivotTables(pvt).PivotFields("Date").EnableMultiplePageItems = True
For Each fld In Sheets("PivotTableSheet").PivotTables(pvt).PivotFields
If fld.Orientation <> xlHidden And (fld.Orientation = xlPageField) Then 'loop through filtered pivot fields
i = 1
For Each pitem In fld.PivotItems 'loop through visible items in filtered pivot fields
If pitem.Visible = True Then
ReDim Preserve arr(1 To i) As Variant
arr(i) = pitem
i = i + 1
End If
Next pitem
Sheets("Données").ListObjects("table1").Range.AutoFilter Field:=TRVFILTRE(fld.Name), Criteria1:=arr, Operator:=xlFilterValues
End If
Next fld
Sheets("PivotTableSheet").PivotTables(pvt).ManualUpdate = False
End Function

Answer 1

When iterating over PivotItems, there's a couple of bottlenecks and gotchas that you want to avoid. See my post at http://dailydoseofexcel.com/archives/2013/11/14/filtering-pivots-based-on-external-ranges/ for more on this.
Among other things, you want to set the PivotTable's ManualUpdate property to TRUE while you do the iteration and then back to FALSE when you're done. Otherwise Excel will try to update the PivotTable each time you change the visibility of a PivotItem. And you also want to ensure that at least one item remains visible at all times. I use something like this:
Option Explicit
Sub FilterPivot()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim i As Long
Dim vItem As Variant
Dim vItems As Variant
Set pt = ActiveSheet.PivotTables("PivotTable1") '<= Change to match your PivotTable
Set pf = pt.PivotFields("CountryName") '<= Change to match your PivotField
vItems = Array("FRANCE", "BELGIUM", "LUXEMBOURG") '<= Change to match the list of items you want to remain visible
pt.ManualUpdate = True 'Stops PivotTable from refreshing after each PivotItem is changed
With pf
'At least one item must remain visible in the PivotTable at all times, so make the first
'item visible, and at the end of the routine, check if it actually *should* be visible
.PivotItems(1).Visible = True
'Hide any other items that aren't already hidden.
'Note that it is far quicker to check the status than to change it.
' So only hide each item if it isn't already hidden
For i = 2 To .PivotItems.Count
If .PivotItems(i).Visible Then .PivotItems(i).Visible = False
Next i
'Make the PivotItems of interest visible
On Error Resume Next 'In case one of the items isn't found
For Each vItem In vItems
.PivotItems(vItem).Visible = True
Next vItem
On Error GoTo 0
'Hide the first PivotItem, unless it is one of the countries of interest
On Error Resume Next
If InStr(UCase(Join(vItems, "|")), UCase(.PivotItems(1))) = 0 Then .PivotItems(1).Visible = False
If Err.Number <> 0 Then
.ClearAllFilters
MsgBox Title:="No Items Found", Prompt:="None of the desired items was found in the Pivot, so I have cleared the filter"
End If
On Error GoTo 0
End With
pt.ManualUpdate = False
End Sub

Answer 2

You don't have to iterate through PivotItems if all you want to do is make each PivotItem visible. Instead, just use the .ClearAllFilters method.
Something like:
With Sheets("PivotTableSheet").PivotTable("PivotTable").PivotFields("Date")
.ClearAllFilters
.CurrentPage = "(All)"
End With