I am still convinced that you cannot apply autofilter to a pivotable data column
The only way I succeded is using this code, that theoretically should insert an autofilter to the empty cell at the right of the data area:
Code:
Sub Pvt_HeadFilt(ByRef PVT As PivotTable)
Dim pSheet As Worksheet, PV1 As String, myMatch
Dim pCC As Long, pRC As Long, FilterCel
Dim TargeTab As String
'
Set pSheet = PVT.Parent
PV1 = PVT.Name
pCC = pSheet.PivotTables(PV1).DataBodyRange.Columns.Count
pRC = pSheet.PivotTables(PV1).DataBodyRange.Rows.Count
FilterCel = pSheet.PivotTables(PV1).DataBodyRange.Cells(1, 1).Offset(-1, pCC).Address
pSheet.AutoFilterMode = False
pSheet.Range(FilterCel).Offset(0, 0).Resize(pRC + 1 - pRC, 1).AutoFilter
End Sub
It is in the form of a Subroutine (a callable Sub) because I recall it from the Sub Worksheet_PivotTableUpdate that I inserted in Sheet2's vba module:
Code:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
If Target.Name = "PVTable2" Then Call Pvt_HeadFilt(Target)
End Sub
The problem with this erratic setting is that also the Row fields (columns A-B-C in the demo tables) get their autofilter replaced, so they loose their native meaning. To restore their native purpose you have to remove the filters (using Menu /Data /Filter)
This is demonstrated in Sheet2 of the demo workbook; update the Pivottable and the column headers will have a dropdown attached
A
second option is to add a column at the right of the pivotable and assign to this column the possibility of filtering based on a selectable field.
This is done with a subroutine like this:
Code:
Sub Pvt_Tot_SideFilt(ByRef PVTT As PivotTable)
'Demo in Sheet3
'
Dim pSheet As Worksheet, cRan As String, myMatch
Dim pCC As Long, pRC As Long, aTots, bTots
Dim pvSh As String, pvCell As String, PV1 As String
Dim FormulaRow As Long, FormulaCol As Long, FilterCel As String
Dim TargeTab As String
'
'
Set pSheet = PVTT.Parent
PV1 = PVTT.Name
pCC = pSheet.PivotTables(PV1).DataBodyRange.Columns.Count
pRC = pSheet.PivotTables(PV1).DataBodyRange.Rows.Count
FilterCel = pSheet.PivotTables(PV1).DataBodyRange.Cells(1, 1).Offset(-1, pCC).Address
'
TargeTab = pSheet.Range(pSheet.PivotTables(PV1).DataBodyRange.Cells(1, 1), _
pSheet.PivotTables(PV1).DataBodyRange.Cells(1, 1).Offset(0, pCC - 0).Resize(pRC)).Address
pSheet.AutoFilterMode = False
Do While Application.WorksheetFunction.CountIf(Range(FilterCel).Resize(1, 100), "Filter") > 0
myMatch = Application.Match("Filter", Range(FilterCel).Resize(1, 100), False)
If IsError(myMatch) Then
Exit Do
Else
Range(Range(FilterCel).Offset(0, myMatch - 2), Range(FilterCel).Offset(0, myMatch - 1).End(xlDown)).ClearContents
End If
'Stop
Loop
Range(FilterCel).Resize(pRC + 2, 100).Clear
Range(FilterCel).Offset(1, 1).Resize(pRC, 1).FormulaArray = "=Index(" & TargeTab & ",0,Match(" & FilterCel & "," & Range(TargeTab).Offset(-1).Resize(1).Address & ", 0))"
Range(FilterCel) = pSheet.PivotTables(PV1).DataBodyRange.Cells(1, 1).Offset(-1, 0)
Range(FilterCel).Offset(0, 1) = "Filter"
'
With Range(FilterCel).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=" & pSheet.PivotTables(PV1).DataBodyRange.Offset(-1).Resize(1).Address
.InCellDropdown = True
End With
ActiveSheet.Range(FilterCel).Offset(0, 1).Resize(pRC + 1, 1).AutoFilter
'Stop
End Sub
It has to be recalled passing as argument the pivottable that have to be managed, and will set at the right of the pivot table a cell that acts as "Index" to the pivot table data field and a column where the content of the selected data field is copied. This added column can be used as filter
I recalled it from the Worksheet_PivotTableUpdate event macro in Sheet3 vba module:
VBA Code:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Call Pvt_Tot_SideFilt(Target)
End Sub
The problem with this method is that the columns at the right of the pivot table are filled with some information; therefore if you update the table and new columns are necessary to represent all the data fields a message will popup asking if these columns may be overwritten
I don't know of a method for avoiding this popup, a relief could be setting the filter column maybe 5-10 columns to the right of the pivottable, so there is some room for pivot to expand before getting in conflict with the filter column.
The demo file that include what I have been presenting can be downloaded here:
byASWINRAJ-MR_Copia di Sample_V-Anth_C00407.xlsm
Bye
