Public Function GoTo_Filtered_SourceData(PT As PivotTable, lDataRow As Long, _
lDataCol As Long)
Dim sSourceDataA1 As String
Dim pvtField As PivotField
Dim vVisible As Variant
Dim lFieldNo As Long
'---Get source data range and goto it
sSourceDataA1 = Application.ConvertFormula(PT.SourceData, _
xlR1C1, xlA1)
Application.Goto Range(sSourceDataA1)
'---Apply filters
With Range(sSourceDataA1)
'---Clear any existing autofilters
.Parent.AutoFilterMode = False
'---Filter for PageField VisibleItems
For Each pvtField In PT.PageFields
vVisible = Store_FilterItems(pvtField)
Call Filter_AutoFilterField(rData:=.Cells, _
sHeader:=pvtField.SourceName, vItems:=vVisible)
Next
'---Filter for RowField(s) of data item at lDataRow
If PT.RowFields.Count > 1 Then
If Has_All_Compact_RowFields(PT) Then
Call Filter_Multiple_RowFields(PT:=PT, _
lArg2:=lDataRow, rData:=.Cells)
Else
MsgBox "Multiple RowFields (not Compact)-will not be filtered"
End If
ElseIf PT.ColumnFields.Count = 1 Then
vVisible = PT.RowRange(lDataRow + 1).Value
Call Filter_AutoFilterField(rData:=.Cells, _
sHeader:=PT.RowFields(1).SourceName, _
vItems:=Array(vVisible))
End If
'---Filter for ColumnField of data item at lDataCol
If PT.ColumnFields.Count > 1 Then
MsgBox "Multiple ColumnFields-will not be filtered"
ElseIf PT.ColumnFields.Count = 1 Then
vVisible = PT.ColumnRange(2, lDataCol).Value
Call Filter_AutoFilterField(rData:=.Cells, _
sHeader:=PT.ColumnFields(1).SourceName, _
vItems:=Array(vVisible))
End If
End With
End Function
Private Function Filter_Multiple_RowFields(PT As PivotTable, _
lArg2 As Long, rData As Range)
Dim rLabels As Range, sField As String, sChildField As String
Dim vFields As Variant, vVisible As Variant
Dim lPosition As Long, lIdx As Long, i As Long
'---Make array of rowfields by position to trace each row in hierarchy
With PT.RowFields
ReDim vFields(1 To .Count)
For lIdx = 1 To .Count
vFields(PT.RowFields(lIdx).Position) = PT.RowFields(lIdx).Name
Next lIdx
End With
'---Set rLabels as subset of RowRange: bottom row is associated with lArg2
With PT.RowRange
sChildField = vFields(UBound(vFields))
Set rLabels = .Cells(2)
While lArg2 > 0
i = i + 1
If rLabels(i).PivotField.Name >= sChildField Then _
lArg2 = lArg2 - 1
Wend
Set rLabels = .Offset(1).Resize(i)
End With
'---Find Field-PivotItem pairs and Apply to AutoFilter
lIdx = lIdx + 1
For i = rLabels.Rows.Count To 1 Step -1
sField = rLabels(i).PivotField.Name
lPosition = Application.Match(sField, vFields, 0)
If lPosition < lIdx Then
vVisible = rLabels(i).PivotItem.Name
Call Filter_AutoFilterField(rData:=rData, _
sHeader:=sField, vItems:=Array(vVisible))
lIdx = lPosition
If lIdx = 1 Then Exit For
End If
Next i
End Function
Private Function Has_All_Compact_RowFields(PT As PivotTable) As Boolean
'---Returns True if all PivotFields are Compact Layout
Dim pvtField As PivotField
For Each pvtField In PT.RowFields
If Not pvtField.LayoutCompactRow Then
Has_All_Compact_RowFields = False
Exit Function
End If
Next pvtField
Has_All_Compact_RowFields = True
End Function
