The task is to automate OLAP pivot table data filtering. There are some items in pivot field named sPivotFieldName I need to exclude. The code below works pretty fine.
With Worksheets(sWorksheetName).PivotTables(sPivotTableName)
With .CubeFields(sCubeFieldName)
.Orientation = xlRowField
.IncludeNewItemsInFilter = True
End With
.PivotFields(sPivotFieldName).HiddenItemsList = vSomeItemsToExclude
End With
But the problem appears when I'm trying to change cube field ".Orientation" property's value to xlPageField. Run-time error 1004 fires each time. Here's an example:
With Worksheets(sWorksheetName).PivotTables(sPivotTableName)
With .CubeFields(sCubeFieldName)
.Orientation = xlPageField
.IncludeNewItemsInFilter = True
End With
.PivotFields(sPivotFieldName).HiddenItemsList = vSomeItemsToExclude
End With
The reason seems to be that items of the fields placed in pagefield aren's visible as they are when placed for example in the rowfield (one can see them as row captions). Or maybe there's something else. What am I missing?
This functionality obviously isn't available for PageFields. Seems to me a workaround is to use the .VisibleITemsList approach instead, but make sure it doesn't include the items you want to exclude.
To do this, you need to dump all the unfiltered items to a variant, loop the variant looking for the term you want to hide, and if you find it, just replace that element for some other element that you don't want to hide. (This saves you having to create a new array without that item in it).
The tricky thing is to get a list of all unfiltered items: .VisibleItemsList won't give it to you if the PivotTable doesn't have some kind of filter applied. So we need to get sneaky by making a copy of the PivotTable, making the PageField of interest a RowField, removing all other fields, and then hoovering up the complete list of items, so we know what should be visible after we remove the ones that should be hidden.
Here's a function that handles filtering no matter whether you're dealing with a RowField or a PageField and no matter whether you want to use the .VisibleItemsList to set the filter, or the .HiddenItemsList
In your particular case, you would call it like so: FilterOLAP SomePivotField, vSomeItemsToExclude, False
Function FilterOLAP(pf As PivotField, vList As Variant, Optional bVisible As Boolean = True)
Dim vAll As Variant
Dim dic As Object
Dim sItem As String
Dim i As Long
Dim wsTemp As Worksheet
Dim ptTemp As PivotTable
Dim pfTemp As PivotField
Dim sPrefix As String
Set dic = CreateObject("Scripting.Dictionary")
With pf
If .Orientation = xlPageField Then
pf.CubeField.EnableMultiplePageItems = True
If Not pf.CubeField.EnableMultiplePageItems Then pf.CubeField.EnableMultiplePageItems = True
End If
If bVisible Then
If .CubeField.IncludeNewItemsInFilter Then .CubeField.IncludeNewItemsInFilter = False
.VisibleItemsList = vList
Else
If .Orientation = xlPageField Then
' Can't use pf.HiddenItemsList on PageFields
' We'll need to manipulate a copy of the PT to get a complete list of visible fields
Set wsTemp = ActiveWorkbook.Worksheets.Add
pf.Parent.TableRange2.Copy wsTemp.Range("A1")
Set ptTemp = wsTemp.Range("A1").PivotTable
With ptTemp
.ColumnGrand = False
.RowGrand = False
.ManualUpdate = True
For Each pfTemp In .VisibleFields
With pfTemp
If .Name <> pf.Name And .Name <> "Values" And .CubeField.Orientation <> xlDataField Then .CubeField.Orientation = xlHidden
End With
Next pfTemp
.ManualUpdate = False
End With
sPrefix = Left(pf.Name, InStrRev(pf.Name, ".")) & "&["
Set pfTemp = ptTemp.PivotFields(pf.Name)
pfTemp.CubeField.Orientation = xlRowField
pfTemp.ClearAllFilters
vAll = Application.Transpose(pfTemp.DataRange)
For i = 1 To UBound(vAll)
vAll(i) = sPrefix & vAll(i) & "]"
dic.Add vAll(i), i
Next i
'Find an item that we know is visible
For i = 1 To UBound(vList)
If Not dic.exists(vList(i)) Then
sItem = vList(i)
Exit For
End If
Next i
'Change any items that should be hidden to sItem
For i = 1 To UBound(vList)
If dic.exists(vList(i)) Then
vAll(dic.Item(vList(i))) = sItem
End If
Next i
.VisibleItemsList = vAll
Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Else
If Not .CubeField.IncludeNewItemsInFilter Then .CubeField.IncludeNewItemsInFilter = True
.HiddenItemsList = vList
End If
End If
End With
End Function