Beste allen,
Ik ben in het verleden al vaak goed geholpen hier dus ik doe nog een poging in iets waar ik al een lange tijd niet uitkom.
Vanwege esthetische redenen wil ik in 'dit deel' van mijn dashboard geen slicers gebruiken. Wel wil ik de gebruiker via een dropdown list de mogelijkheid geven om verschillende combinaties te filteren in een draaitabel.
Ik stuur een testbestand mee.
Concreet: ik wil graag via 2 parameters/dropdown lists een selectie kunnen maken in het filter. In het echte model gaat het om bijna 50 mogelijkheden en bestaat het bronbestand uit bijna een miljoen regels, het moet dus nog wel snel/efficiënt kunnen werken.
Code die ik gevonden heb wat werkt op basis van 1 parameter is (deze uitbreiden naar 2, geen idee hoe ik dat in elkaar zet):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next
If Intersect(Target, Range("H6:H7")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
Set xPFile = xPTable.PivotFields("Category")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub
Hoop dat iemand hier wat mee kan, ben benieuwd.
Met vriendelijke groet,
Murphy
Ik ben in het verleden al vaak goed geholpen hier dus ik doe nog een poging in iets waar ik al een lange tijd niet uitkom.
Vanwege esthetische redenen wil ik in 'dit deel' van mijn dashboard geen slicers gebruiken. Wel wil ik de gebruiker via een dropdown list de mogelijkheid geven om verschillende combinaties te filteren in een draaitabel.
Ik stuur een testbestand mee.
Concreet: ik wil graag via 2 parameters/dropdown lists een selectie kunnen maken in het filter. In het echte model gaat het om bijna 50 mogelijkheden en bestaat het bronbestand uit bijna een miljoen regels, het moet dus nog wel snel/efficiënt kunnen werken.
Code die ik gevonden heb wat werkt op basis van 1 parameter is (deze uitbreiden naar 2, geen idee hoe ik dat in elkaar zet):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next
If Intersect(Target, Range("H6:H7")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
Set xPFile = xPTable.PivotFields("Category")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub
Hoop dat iemand hier wat mee kan, ben benieuwd.
Met vriendelijke groet,
Murphy