VBA - Slicer selection (via loop) is very slow.

[barowan]

Greetings,

I'm using excel2013

I'm using below code to select one specific item from the slicer (Slicer_Naam) this depends on the input from a dropdown list. (There's +600 options, that's why I want to use the dropdownlist with autoadding to be much quicker than the slicers) - If I understand the code right (I adjusted pieces from stuff I found online, I never learned how to code properly) it selects all options in the slicer menu en then checks them one by one untill it has a match with the values in the dropdownlist. Because there's over 600+ options this process takes +- 3 minutes. quite a hassle, because I would like to make a dashboard out of it.

My question:
Is there any way to fasten up the code? I searched the web, to try to find some code that makes the slices select the option based on a cell value (their all using letters, not numerical - they're names) but I couldn't find a solution without using loops. - I feel there's a (much) more effective, efficient way to do this.

Sub SelPg()<code>Dim a As Variant
Dim n As Integer
Dim s As String
Dim i As Integer
Dim m As Long
Dim rr As Integer
Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

Application.DisplayStatusBar = False

Application.EnableEvents = False

ActiveSheet.DisplayPageBreaks = False


With ActiveWorkbook
    With .Sheets("Lijsten_Werkblad_Droplist").Range("Tabel1")
        rrr = .Rows.Count
        ReDim a(rrr, 1)
        a = .Value
    End With
    
    
    With .SlicerCaches("Slicer_Naam")
        .ClearManualFilter
    With .Slicers("Naam")
        With .SlicerCache
            .ShowAllItems = True
            n = .SlicerItems.Count
            For i = 1 To n
                With .SlicerItems(i)
                    For m = 1 To rrr
                    If .Name = a(m, 1) Then GoTo gimp
                    Next m
                    .Selected = False
gimp:           End With
            Next i
        End With
   End With
   End With

   
End With

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

Application.DisplayStatusBar = True

Application.EnableEvents = True

ActiveSheet.DisplayPageBreaks = True
 </code>End Sub

 

[barowan]

none?! Help would be very much appreciated

 

[IrishChristof]

Did you find a solution to this?
I have the same problem.