So, this last time, I decided to take 20 minutes out of my day do a little research on the Google and write a macro that would do exactly that for me. Too much time is now almost no time at all and I have a bit of my work day back.
Here is what I use. If you have suggestions on how to make it more efficient or just better practice (self-taught here folks!), please share in the comments!
Summary of Macro:
Create a worksheet called "HiddenFilterCatch".
Add Cubeset and CubeRankedMember formulas to new sheet (Prompting user for max number of options per slicer to catch)
Please excuse the blog formatting as I use a bit more screen real estate when coding. Enjoy!
*Disclaimer - this worked for me in my specific scenario. You may/may not need to adjust the code to fit your situation. :)
*Disclaimer - this worked for me in my specific scenario. You may/may not need to adjust the code to fit your situation. :)
Option Explicit
Sub MultiplePivotSlicerCaches()
Dim oSlicer As Slicer
Dim oSlicercache As SlicerCache
Dim oSh As Worksheet
Dim SlcrName As String
Dim Col As Integer 'Column Number
Dim Connect As String, Comma As String, oPrn As String, cPrn As String 'Formula pieces
Dim i As Integer 'Number of Slicers
Dim Fmla As String 'Completed Formula
Dim ws As Worksheet
Dim x As Integer 'Max # of Filters determined by user
Dim z As Variant
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Add New Worksheet "HiddenFilterCatch"
z = MsgBox("Do you have a 'HiddenFilterCatch' Worksheet already?", vbYesNo)
If z = vbNo Then
Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
ws.Name = "HiddenFilterCatch"
End If
'Count Slicers in Workbook (For Trouble Shooting Code Only)
'i = 0
'For Each oSlicercache In ThisWorkbook.SlicerCaches
'i = i + 1
'Next
'Set Variables for "=Cubeset()"
Col = 3 'Column Number
Connect = "=Cubeset(" & Chr(34) & "ThisWorkBookDataModel" & Chr(34) & ","
Comma = ","
oPrn = "("
cPrn = ")"
'Distribute Cubeset Formulas onto spreadsheet
Sheets("HiddenFilterCatch").Activate
For Each oSlicercache In ThisWorkbook.SlicerCaches
SlcrName = oSlicercache.Name
Fmla = Connect & SlcrName & Comma & Chr(34) & SlcrName & Chr(34) & cPrn
Cells(9, Col).Formula = Fmla
Col = Col + 1
Next
'Set Variables for "=CubeRankedMember()"
Connect = "=IFERROR(CUBERANKEDMEMBER(" & Chr(34) & "ThisWorkBookDataModel" & Chr(34) & ","
'Distribute CubeRankedMember Formulas onto spreadsheet
Col = 3
x = InputBox(Prompt:="What is the Maximum Number of filters you would like to show?", Title:="Maximum Number of Filters", Default:="4")
For Each oSlicercache In ThisWorkbook.SlicerCaches
'Add formulas for CubeRankedMembers 1 to "x"
For i = 1 To x
Fmla = Connect & Cells(9, Col).Value & ",Row(HiddenFilterCatch!A" & i & "))," & Chr(34) & Chr(34) & ")"
Cells(9 + i, Col).Formula = Connect & Cells(9, Col).Value & ",Row(HiddenFilterCatch!A" & i & "))," & Chr(34) & Chr(34) & ")"
Next
'Add "More than 'x' Selected..." Text formula
Cells(10 + x, Col).Formula = "=IF(" & Right(Fmla, Len(Fmla) - 1) & "=" & Chr(34) & Chr(34) & "," & Right(Fmla, Len(Fmla) - 1) & "," & Chr(34) & "More Than " & x & " Selected..." & Chr(34) & ")"
'Add named Range on Cell below "More Than" formula
Cells(11 + x, Col).Select
With Selection
.Name = Right(Cells(9, Col).Value, Len(Cells(9, Col).Value) - 7)
End With
Col = Col + 1
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
