(Solved) – VBA slicercache export PDF loop breaking down Excel

(solved)-–-vba-slicercache-export-pdf-loop-breaking-down-excel

I’m new to VBA and I’ve been trying to create a macro where we have a list of cost centres (total of 385) and the idea behind it is to go through them one by one through a slicer. After each value was selected it will be PDFed then move to the next one. First time I ran it it worked for the first 20 then it crashed my excel, then the second time it ran 24 and crashed again, so on and so forth. The crash itself doesn’t bring any error messages it just closes down excel.

I’ve used both with and without display alerts and screenupdate however the same result.

Any help is much appreciated.

My code below:

Sub Macro_test1()

Dim strGenericFilePath     As String: strGenericFilePath = "C:Users"
Dim strYear                As String: strYear = Year(Date) & ""
Dim strMonth               As String: strMonth = MonthName(Month(Date)) & ""
Dim strDay                 As String: strDay = Format(Date, "dd.mm.yyyy") & ""


Dim IntSliceCount          As Integer
Dim IntLoop                As Integer
Dim SliceLoop              As Integer
Dim Slice                  As SlicerItem
Dim sC                     As SlicerCache

Set sC = ActiveWorkbook.SlicerCaches("Slicer_CostCentre")

'Application.DisplayAlerts = False
'Application.ScreenUpdating = False

  'This reminds the user to only select the first slicer item
   If sC.VisibleSlicerItems.Count <> 1 Or sC.SlicerItems(1).Selected = False Then
      MsgBox "Please only select first cost centre from slicer in 'Summary Air' tab"
      Exit Sub
   End If


For i = 1 To sC.SlicerItems.Count

    'Do not clear filter as it causes to select all of the items (sC.ClearManualFilter)

    sC.SlicerItems(i).Selected = True
    If i <> 1 Then sC.SlicerItems(i - 1).Selected = False


    'Debug.Print sI.Name
    'Add export to PDF code here
    With sheet1.PageSetup

    .PrintArea = sheet1.Range("A1:V91" & lastRow).Address

    .FitToPagesWide = 1
    .FitToPagesTall = 1

    End With

    sheet2.Range("F7") = sC.SlicerItems(i).Name

   ' Check for year folder and create if needed
If Len(Dir(strGenericFilePath & strYear, vbDirectory)) = 0 Then
 MkDir strGenericFilePath & strYear
End If
' Check for month folder and create if needed
If Len(Dir(strGenericFilePath & strYear & strMonth, vbDirectory)) = 0 Then
 MkDir strGenericFilePath & strYear & strMonth
End If
' Check for date folder and create if needed
If Len(Dir(strGenericFilePath & strYear & strMonth & strDay, vbDirectory)) = 0 Then
 MkDir strGenericFilePath & strYear & strMonth & strDay
End If

' Save File

sheet1.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:= _
strGenericFilePath & strYear & strMonth & strDay & sheet2.Range("F7").Text & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

Next

'Application.DisplayAlerts = True
'Application.ScreenUpdating = True

End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *