VBA* Loop 2 Slicers and Convert them to PDF/Excel in Custom Folder

[Armygeddan]

Final product :

1. Loop both Slicers (Slicer_Region, Slicer_Customer)
2. Save each Slicer loop as a PDF and Excel file
3. Only save certain Tabs in the whole file when exporting to PDF and Excel (Array)
4. Have the File Save Format as YYYY_MM(Previous Month)_FilePath(NamedRange).Pdf/Excel
5. Create a Year and a Month Folder in the File Save Destination if it doesn’t exist

I’ve got #3, #4, and #5 completed but need help with #1 and #2

When running the Loop and Converting the Slicer Items to PDF and Excel, it needs to save each selection in a certain name save format of YYYY_MM_CELLA_CELLB

For Region, I’ve got
“Middle East/Africa” as “MEA” “Asia/Pacific” as “AP” Single names like Canada are standalone as themselves When running the Loop, Asia/Pacific would need to be converting to the format of AP(Slicer_Customer)
So per Save, it will need to look like the following
<CODE> Save 1
– CELLA_CELL1
Save 2
– CELLA_CELL2 Etc
Save 16
– CELLB_CELL1
Save 17
– CELLB_CELL2

</CODE>I’d also like an initial save of both the Slicer Dashboards with nothing selected on the Slicers and name it as “ALL_ALL”
That’s a lot of loops to save but sure beats doing it manually.
Here is how my Slicer looks like (Edited out confidential information)

I’ve only been working with VBA for a couple of months so all of the above is quite a bit advanced for me but would give me a huge learning curve for future projects like this. I’ve got the Basics of VBA down but working with Slicers has thrown me in for a Loop (Pun Intended)

Please note that all my data was initially pulled with OLAP but it is all saved in a PowerPivot Data Model so there should be no worries of external sources when gathering data from external sources when the Slicers are selected.

Thank you so much in advance, I know this is asking a lot.
Here is what I have so far:

(Please Note I am current getting an error on Line 20) Says “For Each Slice In MySlicer.SlicerItem” And the error says “Run-time error '1004' Application-defined or object-defined error”

Sub LoopSlicer()
Dim strGenericFilePath     As String: strGenericFilePath = Range("FilePath")
Dim strYearSlash           As String: strYearSlash = Year(Date) & "\"
Dim strMonthSlash          As String: strMonthSlash = CStr(Format(DateAdd("M", -1, Date), "MM")) & "\"
Dim strYearBracket         As String: strYearBracket = Year(Date) & "_"
Dim strMonthBracket        As String: strMonthBracket = CStr(Format(DateAdd("M", -1, Date), "MM")) & "_" & "Smart_Data_"
Dim strFileName            As String: strFileName = "Standard_Customer"
Dim IntSliceCount          As Integer
Dim IntLoop                As Integer
Dim SliceLoop              As Integer
Dim Slice                  As SlicerItem
Dim MySlicer               As SlicerCache
Set MySlicer = ActiveWorkbook.SlicerCaches("Slicer_Region")
    IntSliceCount = 0
    ' Count slicer options
    For Each Slice In MySlicer.SlicerItem
        IntSliceCount = IntSliceCount + 1
    Next Slice
    ' NOTE:--------------------------------------------------------------------------
    ' When selecting a slicer, all the other slicers in the field must be de-selected
    ' -------------------------------------------------------------------------------
    ' Activate slicers one by one and print
    With MySlicer
        For IntLoop = 1 To IntSliceCount
        ' Activate the current slicer in loop, deactivate rest
            For SliceLoop = 1 To IntSliceCount
                If IntLoop = SliceLoop Then
                    .SlicerItems(IntLoop).Selected = True
                Else
                    .SlicerItems(SliceLoop).Selected = False
                End If
            Next SliceLoop
        Application.DisplayAlerts = False
        ' Check for the Year Folder and create it if it does not exist
        If Len(Dir(strGenericFilePath & strYearSlash, vbDirectory)) = 0 Then
            MkDir strGenericFilePath & strYearSlash
        End If
        
        ' Check for the Month Folder and create it if it does not exist
        If Len(Dir(strGenericFilePath & strYearSlash & strMonthSlash, vbDirectory)) = 0 Then
            MkDir strGenericFilePath & strYearSlash & strMonthSlash
        End If
        On Error Resume Next
        On Error GoTo 0
        
        ' Converts to PDF and saves with YYYY_MM_ Format + Filename based off of FilePath String
        ThisWorkbook.Sheets(Array("TestSheet1", "TestSheet2", "TestSheet3")).Select
        ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:= _
        strGenericFilePath & strYearSlash & strMonthSlash & strYearBracket & strMonthBracket & strFileName, _
        Quality:=QualityStandard, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
        Application.DisplayAlerts = True
        ' Popup Message that the conversion and save is complete as YYYY_MM_Standard_Customer
        MsgBox "File Saved As:" & vbNewLine & "\" & strYearBracket & strMonthBracket & strFileName
        ' De-activate the current slicer in loop, activate the rest
        For SliceLoop = 1 To IntSliceCount
            If IntLoop = SliceLoop Then
                .SlicerItems(IntLoop).Selected = False
            Else
                .SlicerItems(SliceLoop).Selected = True
            End If
        Next SliceLoop
    Next IntLoop
End With
End Sub

 

[Worf]

I’m not able to reproduce the error. Please run this simple code for both slicers and see what happens:

Sub Counter()
Dim sc As SlicerCache
Set sc = ActiveWorkbook.SlicerCaches("operator2")   ' change name here
MsgBox sc.SlicerItems.Count
End Sub

 

[Armygeddan]

I input "Slicer_Region" and got a '1004 error for the line that says

MsgBox sc.SlicerItems.Count

When I input "Slicer_Customer" I got the same error on same line

 

[Armygeddan]

I feel kinda dumb I didn't try this before, but I went the Record Macro route. I had to edit it quite a bit but here is my end product. Is there anyway to simplify it?

Sub Convert_Customer_PDFs()
Dim strGenericFilePath          As String: strGenericFilePath = Range("FilePath")
Dim strYearSlash                As String: strYearSlash = Year(Date) & "\"
Dim strMonthSlash               As String: strMonthSlash = CStr(Format(DateAdd("M", -1, Date), "MM")) & "\"
Dim strYearBracket              As String: strYearBracket = Year(Date) & "_"
Dim strMonthBracket             As String: strMonthBracket = CStr(Format(DateAdd("M", -1, Date), "MM")) & "_" & "Smart_Data_"
Dim strFileName                 As String: strFileName = "Customer"
Dim StrALL                      As String: StrALL = "_ALL"
Dim StrAP                       As String: StrAP = "_AP"
Dim StrCAN                      As String: StrCAN = "_CAN"
Dim StrEUR                      As String: StrEUR = "_EUR"
Dim StrUS                       As String: StrUS = "_US"
Dim SaveAsQuestion              As Integer
    
  ' Pop Up Message asks user if Date and Name are correct
  SaveAsQuestion = MsgBox("Are you sure you want to Save As" & vbNewLine & strYearBracket & strMonthBracket & strFileName + "?", vbYesNo + vbQuestion)
    
  If SaveAsQuestion = vbNo Then
  MsgBox "Please modify Data to save as previous month."
  Exit Sub
  Else
  ' If User presses no, tells them to modify to data to save for previous month.
  End If
  Application.DisplayAlerts = False
    
  ' Hides the tabs we don't want to display on PDF and Excel to customers
  ActiveWorkbook.Sheets(Array("TestSheet1", "TestSheet2", "TestSheet3")).Visible = False
    
  ' Check for year folder and create if needed
  If Len(Dir(strGenericFilePath & strYearSlash, vbDirectory)) = 0 Then
       MkDir strGenericFilePath & strYearSlash
  End If
    
  ' Check for month folder and create if needed
  If Len(Dir(strGenericFilePath & strYearSlash & strMonthSlash, vbDirectory)) = 0 Then
       MkDir strGenericFilePath & strYearSlash & strMonthSlash
  End If
    
  ' Export as Excel document
  ActiveWorkbook.SaveAs Filename:= _
  strGenericFilePath & strYearSlash & strMonthSlash & strYearBracket & strMonthBracket & strFileName & StrALL _
  , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        
  ' Export as ALL PDF
  ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
  strGenericFilePath & strYearSlash & strMonthSlash & strYearBracket & strMonthBracket & strFileName & StrALL _
  , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
  :=False, OpenAfterPublish:=False
        
  ' Export AP as PDF
  ActiveWorkbook.SlicerCaches("Slicer_Region").VisibleSlicerItemsList = Array( _
  "[dimRegionMapping].[Region].&[Asia/Pacific]")
  ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
  strGenericFilePath & strYearSlash & strMonthSlash & strYearBracket & strMonthBracket & strFileName & StrAP _
  , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
  :=False, OpenAfterPublish:=False
        
  ' Export Canada as PDF
  ActiveWorkbook.SlicerCaches("Slicer_Region").VisibleSlicerItemsList = Array( _
  "[dimRegionMapping].[Region].&[Canada]")
  ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
  strGenericFilePath & strYearSlash & strMonthSlash & strYearBracket & strMonthBracket & strFileName & StrCAN _
  , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
  :=False, OpenAfterPublish:=False
        
  ' Export Europe as PDF
  ActiveWorkbook.SlicerCaches("Slicer_Region").VisibleSlicerItemsList = Array( _
  "[dimRegionMapping].[Region].&[Europe]")
  ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
  strGenericFilePath & strYearSlash & strMonthSlash & strYearBracket & strMonthBracket & strFileName & StrEUR _
  , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
  :=False, OpenAfterPublish:=False
        
  ' Export US as PDF
  ActiveWorkbook.SlicerCaches("Slicer_Region").VisibleSlicerItemsList = Array( _
  "[dimRegionMapping].[Region].&[United States]")
  ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
  strGenericFilePath & strYearSlash & strMonthSlash & strYearBracket & strMonthBracket & strFileName & StrUS _
  , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
  :=False, OpenAfterPublish:=False
        
  Application.DisplayAlerts = True
  
  ' Popup Message that the conversion and save is complete as YYYY_MM_Customer
  MsgBox "PDF and Excel File Saves complete"
        
End Sub

 

[Armygeddan]

Yeah, if possible from reading that code, can you make it into a loop VBA? Purpose of it is in the future when we add/delete costumers and someone has to work with this dashboard with zero knowledge of VBA, they won't have to change a thing. But in its current condition, a person would have to go into the VBA and manually add/delete code to update.

Code above does everything I want, would just like it in loop form that it would never have to get edited again. Thanks

 

[Worf]

I’m not a power pivot user, so I can’t test with your syntax, but here’s an idea:
Instead of hard coding names (Canada, Europe, US) in the macro, make the argument to the list property variable. Then, you can pass values to the code, which is going to be always the same.
This thread shows how to do it: Using variant in array causes Excel VBA type mismatch error - Stack Overflow

 

[Armygeddan]

Not gonna lie, being so new to VBA, I'm barely comprehending what is going on in that thread. I see loop coding but nothing about saving as pdf etc. I see he is as well working with multiple slicers but I don't see what he is trying to accomplish as the end product from the codes I am looking at.
Anyway you can make a frame of code from that thread that I can play with and throw in areas to let me know what goes where from your undertsanding of what I'm trying to accomplish?

 

[Worf]

Hi

- I have Office Home 2013 and apparently Power Pivot is not included. What Office flavour are you using?
- From what I understood you need to use a variable argument for filtering. If you place a list of values on the worksheet, the code can read them. See if the example below works.

Sub VarArgument()
Dim r$, ws As Worksheet
Set ws = ActiveSheet
r = "[dimRegionMapping].[Region].&" & ws.[k50]                                      ' cell K50 contains [Europe]
MsgBox r
ActiveWorkbook.SlicerCaches("Slicer_Region").VisibleSlicerItemsList = Array(r)     ' <== does this work?
End Sub

 

[Armygeddan]

When I ran this code, it came up with a message box that said "[dimRegionMapping].[Region].&Europe"
"
After a few seconds, it came up with a '1004 error that says "The item could not be found in the OLAP Cube"
When running debug for that '1004, it highlighted in yellow
"

ActiveWorkbook.SlicerCaches("Slicer_Region").VisibleSlicerItemsList = Array(r)     ' <== Does this work?

 

[Armygeddan]

Correction, I forgot to initially add in the brackets to "Europe"

When I made this fix, the code ran through and selected the Europe Slicer. Great success!

 

[Worf]

Hi

- The code below will read the regions from column B on the active sheet and generate the pdf files.
- My example saves only the active sheet, but this can be easily changed.

PivotSheet2

*	B
1	[Asia/Pacific]
2	[Canada]
3	[Europe]
4	[United States]

<tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4

Sub LoopFilters()
Dim strGenericFilePath          As String: strGenericFilePath = Range("FilePath")
Dim strYearSlash                As String: strYearSlash = Year(Date) & "\"
Dim strMonthSlash               As String: strMonthSlash = CStr(Format(DateAdd("M", -1, Date), "MM")) & "\"
Dim strYearBracket              As String: strYearBracket = Year(Date) & "_"
Dim strMonthBracket             As String
strMonthBracket = CStr(Format(DateAdd("M", -1, Date), "MM")) & "_" & "Smart_Data_"
Dim strFileName                 As String: strFileName = "Customer"
Dim StrALL                      As String: StrALL = "_ALL"
Dim StrAP                       As String: StrAP = "_AP"
Dim StrCAN                      As String: StrCAN = "_CAN"
Dim StrEUR                      As String: StrEUR = "_EUR"
Dim StrUS$, v$, i%, ws As Worksheet


Set ws = ActiveSheet
For i = 1 To ws.Range("b" & Rows.Count).End(xlUp).Row
   v = "[dimRegionMapping].[Region].&" & Cells(i, 2)
    MsgBox v
    ActiveWorkbook.SlicerCaches("Slicer_Region").VisibleSlicerItemsList = Array(v)
    ws.ExportAsFixedFormat xlTypePDF, strGenericFilePath & strYearSlash & strMonthSlash & _
    strYearBracket & strMonthBracket & strFileName & Conv(Cells(i, 2)), xlQualityStandard, 1, 0, , , 0
Next
End Sub


Function Conv$(sc$)
Dim j%, c%
Conv = ""
Select Case InStr(sc, "/")
    Case Is > 0
        For j = 1 To Len(sc)
            c = Asc(Mid(sc, j, 1))
            If c > 64 And c < 91 Then Conv = Conv & Mid(sc, j, 1)
        Next
End Select
If Len(Conv) = 0 Then Conv = sc
End Function