Use VBA to select and deselect multiple slicer items (OLAP data) - vba

Question

I am working on a script which selects only the needed slicer items. I tried using .SlicerItems.Selected = True / False for selecting and deselecting but I am using an OLAP data source in which case .Selected is read-only. The slicer items are in the format of YYYYWW so 7th week of 2018 would be 201807.
I recorded a macro selecting some slicer items and this is what it gave me:
Sub Macro2()
ActiveWorkbook.SlicerCaches("Slicer_YYYYWW").VisibleSlicerItemsList = Array( _
"[Results].[YYYYWW].&[201726]", "[Results].[YYYYWW].&[201727]", _
"[Results].[YYYYWW].&[201728]", "[Results].[YYYYWW].&[201729]", _
"[Results].[YYYYWW].&[201730]", "[Results].[YYYYWW].&[201731]", _
"[Results].[YYYYWW].&[201732]", "[Results].[YYYYWW].&[201733]", _
"[Results].[YYYYWW].&[201734]", "[Results].[YYYYWW].&[201735]", _
"[Results].[YYYYWW].&[201736]", "[Results].[YYYYWW].&[201737]", _
"[Results].[YYYYWW].&[201738]", "[Results].[YYYYWW].&[201739]", _
"[Results].[YYYYWW].&[201740]", "[Results].[YYYYWW].&[201741]", _
"[Results].[YYYYWW].&[201742]", "[Results].[YYYYWW].&[201743]", _
"[Results].[YYYYWW].&[201744]", "[Results].[YYYYWW].&[201745]", _
"[Results].[YYYYWW].&[201746]", "[Results].[YYYYWW].&[201747]", _
"[Results].[YYYYWW].&[201748]", "[Results].[YYYYWW].&[201749]", _
"[Results].[YYYYWW].&[201750]", "[Results].[YYYYWW].&[201751]", _
"[Results].[YYYYWW].&[201801]", "[Results].[YYYYWW].&[201802]", _
"[Results].[YYYYWW].&[201803]")
End Sub
So I tried following this template and create an array like that. This is how far I have gotten:
Sub arrayTest()
Dim startDate As Long
Dim endDate As Long
Dim n As Long
Dim i As Long
Dim strN As String
Dim sl As SlicerItem
Dim strArr As Variant
Dim dur As Long
Dim result As String
endDate = Range("C17").Value ' endDate is the last SlicerItem to be selected
startDate = Range("G17").Value ' startDate is the first SlicerItem to be selected
dur = Range("C19").Value ' duration is the the number of SlicerItems to be selected
i = 0
ReDim strArr(dur) As Variant
With ActiveWorkbook.SlicerCaches("Slicer_YYYYWW")
' .ClearManualFilter
For n = startDate To endDate
strN = CStr(n) ' convert n to string
If n = 201753 Then ' this is needed for when the year changes
strN = CStr(201801)
n = 201801
End If
strArr(i) = """[Results].[YYYYWW].&[" & strN & "]""" ' write string into array
i = i + 1
' For Each sl In .SlicerCacheLevels(1).SlicerItems
' If sl.Name = strN Then
' sl.Selected = True
' Else
' sl.Selected = False ' this is read-only for OLAP data so it's not working
' End If
' Next
Next
MsgBox Join(strArr, ", ") ' the MsgBox returns the correct string to be applied to select the right slicer items
.VisibleSlicerItemsList = Join(strArr, ", ") ' Error 13: Type mismatch
End With
End Sub
Currently, the code gives Error 13: Type mismatch on .VisibleSlicerItemsList = Join(strArr, ", "), which is also commented. So I'm guessing that either dimensioning strArr as Variant is wrong, the data is not inserted correctly into strArr or it's just impossible to do it this way. In the case of the latest one, how should I do it?
The part commented out on lines 29-35 does not work as it gives the usual error of Application-defined or object-defined error (1004) on sl.Selected = False.

Answer 1

I had a similar issue to overcome. Which I resolved using the following code:
Sub show_SlicerItems()
Dim sc As SlicerCache
Dim sL As SlicerCacheLevel
Dim si As SlicerItem
Dim slicerItems_Array()
Dim i As Long
Application.ScreenUpdating = False
Set sc = ActiveWorkbook.SlicerCaches("Slicer_Name")
Set sL = sc.SlicerCacheLevels(1)
ActiveWorkbook.SlicerCaches("Slicer_Name").ClearManualFilter
i = 0
For Each si In sL.SlicerItems
ReDim Preserve slicerItems_Array(i)
If si.Value <> 0 Then
slicerItems_Array(i) = si.Name
i = i + 1
End If
Next
sc.VisibleSlicerItemsList = Array(slicerItems_Array)
Application.ScreenUpdating = True
End Sub

Answer 2

You need to feed .VisibleSlicerItemsList an array, not a string. Ditch the Join.
And your strArr assignment should be like this: strArr(i) = "[Results].[YYYYWW].&[" & strN & "]" i.e. you don't need to pad it out with extra "
Edit: Out of interest, I happen to be building a commercial add-in that is effectively a Pop-up Slicer, that allows you to filter an OLAP PivotTable to show all items between a range like you are attempting to do. It also lets you filter on wildcards, crazy combinations of AND and OR, and filter on lists stored in external ranges.
Here's a screenshot of it in action. Note there is a search bar up the top that lets you use < or > together to set lower and upper limits, which is what I've done in the current Search. And you can see the result: it has correctly identified the 14 items from the PivotField that fit the bill.
All I need to do to filter the PivotTable on these is click the "Filter on selected items" option, and it does just that:
But working out how to do this - particularly given the limitations of the PivotTable object model (especially where OLAP PivotTables are concerned) was a VERY long term project, with many, many hurdles to overcome to make it work seamlessly. I can't share the code I'm afraid, as this is a commercial offering that I aim to release shortly. But I just wanted to highlight that while this is certainly possible, you are going to be biting off quite a bit if you want it to not throw errors when items don't exist.

Answer 3

Forget my other answer...you can use the Labels Filter to do this easily, provided the field of interest is in the PivotTable as either a Rows or Columns field. Fire up the Macro Recorder, and do the following:
...and you'll see that the PivotTable gets filtered:
...and the resulting code is pretty simple:
ActiveSheet.PivotTables("PivotTable1").PivotFields("[Table1].[YYYYWW].[YYYYWW]" _
).PivotFilters.Add2 Type:=xlCaptionIsBetween, Value1:="201726", Value2:= _
"201803"

Answer 4

Use this:
Sub seleciona_lojas()
Dim strArr()
Dim x As Long
Dim i As Long
For x = 2 To 262
ReDim Preserve strArr(i)
strArr(i) = "[Lojas].[Location_Cd].&[" & Planilha5.Range("B" & x).Value & "]"
i = i + 1
Next x
ActiveWorkbook.SlicerCaches("SegmentaçãodeDados_Location_Cd1").VisibleSlicerItemsList = strArr
End Sub