rijlabel draaitabel filteren met celwaarde

[MrVanderBrink]

Hallo,

Ik probeer een voorraadoverzicht gebruiksvriendelijk te maken. Dit overzicht bestaat uit verschillende draaitabellen met telkens anders ingestelde rapportfilters (seizoen en locatie). In principe is het niet aan de gebruikers om de filters in de draaitabel aan te passen.

Ik zou graag willen dat er in de kop van de sheet een invulcel is. De waarde die daar getypt wordt, wordt gebruikt om in de rijlabel "Model" te filteren op bevat deze waarde.

Het is me gelukt (met hulp van internet) om de rapportfilter met een celwaarde te beïnvloeden. Het lukt me niet om dat toe te passen op het filteren van rijlabels. Ook moet de waarde exact zijn. Het lukt me niet om er "bevat" van te maken.

In de bijlage mijn test bestandje waar op tab Voorbeeld1 het lukt om de rapportfilter te beïnvloeden en op tab voorbeeld 2 niet lukt om de filter op rijlabel te beïnvloeden.Bekijk bijlage pivot filter op cel.xlsm

Kan iemand helpen?

 

[VenA]

Probeer het eens met deze.

Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim s As String
    s = Range("I6").Value
    If Not Intersect(Target, Range("I6")) Is Nothing Then
        With Sheets("Voorbeeld2").PivotTables("Draaitabel1").PivotFields("I")
            .ClearAllFilters
            For Each p In .PivotItems
                If p.Value <> s Then p.Visible = False Else p.Visible = True
            Next p
        End With
    End If
End Sub

 

[MrVanderBrink]

rijlabel draaitabel filteren met celwaarde deel 2

Beste VenA,

Ja, dit lijkt aardig de goede kant op te gaan. Echter loopt de sheet volledig vast als ik de zoekwaarde delete. Ook zoek op "bevat" geeft een fout.

Even een nieuw voorbeeld gemaakt met de nieuwe bijna werkende code: Bekijk bijlage test2.xlsm

Kunt u voor mij de code zo aanpassen dat invul: leeg, of een halve waarde ook resultaten opleveren?
Waar stuur ik de fles wijn heen?

Alvast bedankt.

 

[VenA]

Probeer deze eens. Gaat alleen fout als je een niet bestaande waarde in B1 zet.

Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim s As String
s = Range("B1").Value
If Not Intersect(Target, Range("B1")) Is Nothing Then
    With Sheets("Blad4").PivotTables("Draaitabel1").PivotFields("Hoofdartikel")
        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

 

[MrVanderBrink]

rijlabel draaitabel filteren met celwaarde deel 3

Beste VenA,

Top! Dit is het bijna.
Is er echt niets te bedenken op een waarde die niet gevonden kan worden? Iets als:

If Target.Value = "not searchable" Then
            .ClearAllFilters
En If

"not searchable" zuig ik natuurlijk uit mn duim.

Het komt namelijk regelmatig voor dat ik op zoek ben naar een artikel dat niet op voorraad is en dus niet in de lijst voor komt.

 

[HSV]

Voor het vergelijken op bevat: Typ een jokerteken voor en/of na het cijfer (bv. *12* of *12 of 12*)

Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim x As Boolean
If Target.Address(0, 0) = "B1" Then
    With Me.PivotTables("Draaitabel1").PivotFields("Hoofdartikel")
    .ClearAllFilters
     For i = 1 To .PivotItems.Count
        With .PivotItems(i)
           If .Value Like CStr(Target.Value) Then
                 .Visible = True
                 x = True
            ElseIf i = .Parent.PivotItems.Count And x = False Then
                       .Parent.ClearAllFilters
                    MsgBox "Waarde niet gevonden!"
                     Application.EnableEvents = True
                    Exit Sub
            Else
                .Visible = False
            End If
        End With
      Next i
  End With
End If
Application.EnableEvents = True
End Sub

 

[MrVanderBrink]

opgelost

Dit is hem!
VenA en HSV, ontzettend bedankt voor jullie hulp.

*enige tijd later..
Hij werkt nog steeds, maar er moet bij opgemerkt worden dat als dit wordt toegepast op een grote tabel, het wel heel erg veel tijd kost om de code te laten lopen. Gebruikersgemak van een zoekveld weegt dan niet op tegen de tijd die je er op moet wachten.

Gevraagde code doet exact wat ik gevraagd heb op dit forum. Het in gebruik nemen kan helaas niet. Nog steeds heel interessant en ontzettend bedankt voor de code.