Hi all,

I am not very familiar how slicers interact with VBA, so I am hoping someone can help with this problem:
I have a number of picot tables updated by slicers, and I have written a loop that cycles through all slicer values on a given slicer and exports a sheet to a new file each time the loop completes.

However, I then added another action to the look. Basically, for each loop of the slicer, I want to select a specific value of another slicer (and only that one value). The value that needs to be selected is provided in a cell on another worksheet.

The initial loop worked fine - however, adding the second slicer increases run time to something unbearable (2 hours per loop), and Excel crashes frequently. I probably got something wrong with "For" "Next" or "End With" Statements - as I said, the macro tages ages to even complete a single loop (2 hours).

Here is my code:

Sub LoopThroughSlicer1()
Application.ScreenUpdating = False

Dim sI As SlicerItem, sI2 As SlicerItem, sC As SlicerCache

' This loops through the first slicer, and repeats the actions below for each value
Set sC = ActiveWorkbook.SlicerCaches("Slicer_1")
With sC
    For Each sI In sC.SlicerItems
        sC.ClearManualFilter
        For Each sI2 In sC.SlicerItems
            If sI.Name = sI2.Name Then sI2.Selected = True Else: sI2.Selected = False
        Next


''This is supposed to select only a single, specific item in a second slicer (not loop through all), according to a value in cell C1
With ActiveWorkbook.SlicerCaches("Slicer_2") 'refer to slicer in copy of pivot sheet
    For Each oSlicerItem In .SlicerItems
        If oSlicerItem.Name <> Sheets("Sheet2").Range("C1") Then
            oSlicerItem.Selected = False
        Else
            oSlicerItem.Selected = True
        End If
    Next oSlicerItem
End With

Application.Calculate

'This saves a specific sheet as a separate workbook and closes it
ThisWorkbook.Sheets(Array("Sheet1")).Select
Sheets("Sheet1").Select
fileSaveName = "C:\Users\as_sass\" & Sheets("Sheet1").Range("B1")
ActiveSheet.Copy
Cells.Copy
Cells.PasteSpecial xlPasteValues
ThisWorkbook.CheckCompatibility = False
ActiveWorkbook.SaveAs Filename:=fileSaveName, FileFormat:=51, CreateBackup:=False
ActiveWorkbook.Close


    Next
    
'The Loop should then start from the beginning
    
End With
Application.ScreenUpdating = True
End Sub

Any help is appreciated!

as