Tuesday, April 21, 2015

Catching those slicer selections: A macro to do the work for you...

I've been working with PowerPivot for some time now and one thing that I've noticed on each of my solutions that I create is that I spend too much time creating the hidden sheet that "catches" each of the slicer selections that are active.  This can sometimes take hours if the project is big enough.

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.  :)

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
'Set Variables for "=Cubeset()"
    Col = 3 'Column Number
    Connect = "=Cubeset(" & Chr(34) & "ThisWorkBookDataModel" & Chr(34) & ","
    Comma = ","
    oPrn = "("
    cPrn = ")"
'Distribute Cubeset Formulas onto spreadsheet
    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
'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) & ")"
            '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


    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

No comments:

Post a Comment