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

 

[Armygeddan]

Bump

 

[Armygeddan]

Bump

 

[Worf]

Hi

- Please test the preliminary code below. It generates all the PDF files, but using full names. I will write the conversion part later.
- As I don’t have your actual project, check if the filters are being applied correctly.
- Are the two slicers on the same worksheet?

Sub LoopSlicer()
Dim GenFilePath$: GenFilePath = Range("FilePath")
Dim ySlash$: ySlash = Year(Date) & "\"
Dim strMonthSlash$: strMonthSlash = CStr(Format(DateAdd("M", -1, Date), "MM")) & "\"
Dim strYearBracket$: strYearBracket = Year(Date) & "_"
Dim strMonthBracket$: strMonthBracket = CStr(Format(DateAdd("M", -1, Date), "MM")) & "_" & "Smart_Data_"
Dim fname$, Slicer1Count%, slicer2count%, IntLoop%, j%, k%
Dim SliceLoop%, Slice As SlicerItem, myslicer1 As SlicerCache, myslicer2 As SlicerCache
Set myslicer1 = ActiveWorkbook.SlicerCaches("Slicer_Region")
Set myslicer2 = ActiveWorkbook.SlicerCaches("Slicer_Customer")
Slicer1Count = myslicer1.SlicerItems.Count
slicer2count = myslicer2.SlicerItems.Count
' When selecting an item, all the other items in the slicer must be de-selected
For IntLoop = 1 To Slicer1Count
    Sheets("project").Activate              ' sheet where the slicers are
    For SliceLoop = 1 To Slicer1Count       ' Activate the current item in loop, deactivate rest
        If IntLoop = SliceLoop Then
            myslicer1.SlicerItems(IntLoop).Selected = True
        Else
            myslicer1.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(GenFilePath & ySlash, vbDirectory)) = 0 Then MkDir GenFilePath & ySlash
    ' Check for the Month Folder and create it if it does not exist
    If Len(Dir(GenFilePath & ySlash & strMonthSlash, vbDirectory)) = 0 Then MkDir GenFilePath & ySlash & strMonthSlash
    For j = 1 To slicer2count
        Sheets("project").Activate
        For k = 1 To slicer2count                           ' second slicer
            If j = k Then
                myslicer2.SlicerItems(j).Selected = True
            Else
                myslicer2.SlicerItems(k).Selected = False
            End If
        Next
        ThisWorkbook.Sheets(Array("TestSheet1", "TestSheet2", "TestSheet3")).Select
        fname = GenFilePath & ySlash & strMonthSlash & strYearBracket & strMonthBracket & _
        myslicer1.SlicerItems(IntLoop).Caption & "-" & myslicer2.SlicerItems(j).Caption
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fname, _
        Quality:=xlQualityStandard, IgnorePrintAreas:=False, OpenAfterPublish:=False
        Application.DisplayAlerts = True
        MsgBox "File Saved As:" & vbNewLine & "\" & fname
    Next
Next IntLoop
End Sub

 

[Worf]

The conversion code for your testing:

Sub Converter()
Dim arr, i%, j%, s$, c%
arr = Array("Middle East/Africa", "Asia/Pacific", "Canada", "Zulu/Zigzag")
For i = LBound(arr) To UBound(arr)
    s = ""
    Select Case InStr(arr(i), "/")
        Case Is > 0
            For j = 1 To Len(arr(i))
                c = Asc(Mid(arr(i), j, 1))
                If c > 64 And c < 91 Then s = s & Mid(arr(i), j, 1)
            Next
            arr(i) = s
    End Select
    MsgBox arr(i)
Next
End Sub

 

[Worf]

I’d also like an initial save of both the Slicer Dashboards with nothing selected on the Slicers and name it as “ALL_ALL”

Sub NothingSelected()
Dim ws As Worksheet
Set ws = ActiveSheet
ActiveWorkbook.SlicerCaches("Slicer_Customer").ClearManualFilter
ActiveWorkbook.SlicerCaches("Slicer_Region").ClearManualFilter
ws.ExportAsFixedFormat xlTypePDF, "c:\pub\all_all2", xlQualityStandard, , 0, , , 0
End Sub

 

[Armygeddan]

Slicer Loop Code:

When running this, I got an error on the line that says

Slicer1Count = myslicer1.SlicerItems.Count

The error is a '1004 Application-defined or object-defined error.

I changed the Sheet name to the one both the Slicers are located in.
On the main sheet where I am running the Slicers, there actually a lot more Slicers but only 2 are phiscially displayed like the picture in my post. I ran the following code to get the names. Hope that helps going foward.

 Sub SlicerCheck()
Dim MySlicer As SlicerCache
For Each MySlicer In ActiveWorkbook.SlicerCaches
Debug.Print MySlicer.Name
Next
End Sub

The results came out as

Slicer_CompletedMonth
Slicer_CompletedYear
Slicer_Customer
Slicer_Region
Slicer_CompletedMonth
Slicer_CompletedYear
Slicer_Customer
Slicer_Region
Slicer_CompletedMonth
Slicer_CompletedYear
Slicer_Customer
Slicer_Region
Slicer_CompletedMonth
Slicer_CompletedYear
Slicer_Customer
Slicer_Region
Slicer_CompletedMonth
Slicer_CompletedYear
Slicer_Customer
Slicer_Region

Conversion Code:

When I ran the Converter Code, on my Dashboard I had 4 pop ups that came up that only said in each one "MEA", "AP", "Canada", and "ZZ"

NothingSelected Code:

When I attempted to run this, it came up with an error that said

"Run-time error '-2147024773(8007007b)':
Document not saved."

And when I pressed Debug, it highlighted the entire bottom line of the code which says

ws.ExportAsFixedFormat xlTypePDF, "C:\Users\Desktop\Test_Folder\", xlQualityStandard, , 0, , , 0

Hope this is detailed enough. Thanks!

 

[Worf]

1) There are several slicers with the same name (customer and region). Try renaming so that these names become unique to the two slicers we are using.
2) The conversion seems to be working correctly, compare the output with the original strings on my code. I will add this to the main code.
3) Try adding a file name like this: "C:\Users\Desktop\Test_Folder\all_all"

 

[Armygeddan]

1. How would I go about changing the name of the Slicers? I could change these two by adding like a 1 at the end of the name once I find out how so we would only be working with them.
Here is what I get when I click on Slicer Settings

Could we use the "Region 1" in the code? I don't want to change too much stuff as the Dashboards I'm working with are pretty complicated so too modify something like this could drastically alter items.

2. That's great news.
3. Do you want me to create a new folder in the "Test_Folder" called "ALL_ALL" or just add that to the end of the Filepath without the folder?

 

[Worf]

- That dialog box can be used to change the names of the two slicers as you suggested. Run the code below afterwards to ensure the operation was successful.
- Just add. Using that syntax, a pdf file named “all_all “will be created in the test folder, no need for folder creation.

Sub ShapeNames()
Dim i%
For i = 1 To ActiveSheet.Shapes.Count
MsgBox ActiveSheet.Shapes(i).Name, 64, "Shape #" & i
Next
End Sub