Vba code automatisch filteren in draaitabellen uit celwaarde

[Benelucky]

Hallo,

Met onderstaande code lukt het om draaitabellen op verschillende tabbladen te filteren op basis van een waarde in andere cel. De code loopt alleen nog vast zodra de waarde in cel niet voorkomt in te filteren optie in de draaitabel. Zie het dikgedrukte stukje in de code.

Wie kan mij verder helpen? Dank alvast!

Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim s As String
s = Range("B6").Value
If Not Intersect(Target, Range("B6")) Is Nothing Then
    With Sheets("Blad2").PivotTables("Draaitabel1").PivotFields("Locatie")
        If Target.Value = "" Then
            .ClearAllFilters
        Else
            .ClearAllFilters
            For Each p In .PivotItems
                If InStr(1, p.Value, s, 1) = 0 Then [U][/U][B]p.Visible = False Else [/B]p.Visible = True
            Next p
        End If
    End With
End If
If Not Intersect(Target, Range("B6")) Is Nothing Then
    With Sheets("Blad 3").PivotTables("Draaitabel2").PivotFields("Locatie")
        If Target.Value = "" Then
            .ClearAllFilters
        Else
            .ClearAllFilters
            For Each p In .PivotItems
                If InStr(1, p.Value, s, 1) = 0 Then p.Visible = False Else p.Visible = True
            Next p
        End If
    End With
End If
End Sub

Groet,
Benelucky

 

[Peter B]

Ik zie zo niets vreemds, maar misschien in een voorbeeldbestand wel?

Ik zou overigens de .ClearAllFilters uit de IF-THEN-ELSE halen. In beide gevallen wil je hem uitvoeren.

 

[VenA]

Als je weet waarom je het doet dan is On Error Resume Next een optie. Omdat er geen voorbeeldbestandje bij zit zelf maar wat in elkaar gedraaid.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$6" Then
    On Error Resume Next
    With Sheet1.PivotTables("PivotTable1").PivotFields("Naam")
        .ClearAllFilters
        .PivotFilters.Add Type:=xlCaptionContains, Value1:=Target
    End With
    With Sheet4.PivotTables("PivotTable1").PivotFields("Naam")
        .ClearAllFilters
        .PivotFilters.Add Type:=xlCaptionContains, Value1:=Target
    End With
End If
End Sub

 

[Benelucky]

Beste Peter B en VenA, dank voor jullie reactie!!!

Ik ga er mee aan de slag en ik laat het even weten. Mocht ik er niet uit komen dan zal ik kijken of ik een voorbeeldbestandje bij kan voegen.