VBA Excel Table with multiple criteria filter

[CarlAbdelnour]

Function tableau
Dim fld As PivotField
Dim pitem As PivotItem
Dim i As Long
Dim arr() As Variant




Sheets("PivotTableSheet").Activate
For Each fld In Sheets("PivotTableSheet").PivotTables("PivotTable").PivotFields
If fld.Orientation <> xlHidden And fld.Orientation = xlColumnField 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 arr(1 To i) As Variant
arr(i) = pitem
Sheets("Données").ListObjects("table1").Range.AutoFilter Field:=TRVFILTRE(fld.Name), Criteria1:=arr, Operator:=xlFilterValues
i = i + 1
End If
Next pitem
End If
Next fld


End Function








Hello, I would like to know if I can filter a table based on multiple criteria (in a dynamic array)
The function is filtering the table with the last item in the array arr(), I'd like it to filter all the items in the array. TRVFILTRE(fld.name) finds the column of the field name
and returns a number.


It would be great to have a solution
Thank you a lot for the help

 

[jmacleary]

You need to move the line 'Sheets("Données").ListObjects("table1").Range.AutoFilter Field:=TRVFILTRE(fld.Name), Criteria1:=arr, Operator:=xlFilterValues' down as shown:

Function tableau
	Dim fld As PivotField
	Dim pitem As PivotItem
	Dim i As Long
	Dim arr() As Variant




	Sheets("PivotTableSheet").Activate
	For Each fld In Sheets("PivotTableSheet").PivotTables("PivotTable").PivotFields
    	If fld.Orientation <> xlHidden And fld.Orientation = xlColumnField 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 arr(1 To i) As Variant
                	arr(i) = pitem
i = i + 1
            	End If
        	Next pitem
    	[COLOR=#ff0000]Sheets("Données").ListObjects("table1").Range.AutoFilter  Field:=TRVFILTRE(fld.Name), Criteria1:=arr, Operator:=xlFilterValues
                	[/COLOR]End If
	Next fld


	End Function

 

[CarlAbdelnour]

Thank you for the help but the code is still filtering the last item in the array (and not the entire array). I think the code is correct but arr is taking only the last item in the array. Do you have any ideas?

Thanks

 

[jmacleary]

Ah yes sorry I missed it. Its the redim - every time its executed it clears the array of entries. Change the redim line to: ReDim Preserve arr(1 To i) As Variant. The Preserve clause keeps existing values.

 

[CarlAbdelnour]

Works! Thank you!
Another quick question:
Instead of looping through column fields I am trying to loop through Pagefields containing dates but I have an error 13 type incompatibility when I set the pitem property to visible.
I changed the field format to date. I have a similar code in a userform and it's working well for the same field and pivot table.
Do you have any ideas?
Thanks again