Filter dynamic table by word in a cell

Question

This other one just below the same post of the link above .. has difference in running ? ... https://stackoverflow.com/a/43139189/9948374

There is a way to speed up the execution of some of these codes. Binary format type ... or change n same code.. ?

I put a button to execute. because with.

Private Sub Worksheet_selectionchange(Byval Target As Range)

As soon as I put the first letter it already starts to run .. this leaves the spreadsheet "heavy" ... would like if not with a button were to give enter in cell "C18" . (At the end of each word searched).

@danieltakeshi, I would like when deleting the cell.. ("C18") = Empty .. to appear in the place "Search by address here".. execute Clearallfilters... in case the cell ("C18") whenever there is no search to do will have "Search by address here".

but the filter has behaved this way with the code... selects the last filter item with text searches that do not have among the options.

It’s like this..

Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Range)
    'https://stackoverflow.com/questions/42929493/filter-items-with-certain-text-in-a-pivot-table-using-vba
    Dim PvtTbl      As PivotTable
    Dim PvtItm      As PivotItem
    Dim f           As String

    On Error GoTo Sair
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    If Target.Address = "$C$18" Then
        f = Target.Value

        ' set the pivot table
        Set PvtTbl = PivotTables("Tabela dinâmica9")
            PvtTbl.ManualUpdate = True
        With PvtTbl.PivotFields("Conteúdo variável 5")
            .ClearAllFilters

            For Each PvtItm In .PivotItems
                If PvtItm.Name Like "*" & f & "*" Then
                    PvtItm.Visible = True
                Else
                    PvtItm.Visible = False


                End If
            Next PvtItm
        End With

    End If
Sair:
    Set PvtTbl = PivotTables("Tabela dinâmica9")
    PvtTbl.ManualUpdate = False
    Debug.Print Err.Number
    On Error GoTo 0
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub
Private Sub TextBox1_Change()
textoDigitado = Range("$C$18").Text
Call PreencheLista
End Sub

Private Sub UserForm_Initialize()
'Ao iniciar o formulario ira chamar o procedimento PreencheLista
Call PreencheLista
End Sub


Private Sub PreencheLista()
textoDigitado = TextBox1.Text
'código que irá filtrar os nomes
Dim linha As Integer
Dim TextoCelula As String
linha = 1
'limpa os dados do formulário
ListBox1.Clear
'Irá executar até o último nome
While ActiveSheet.Cells(linha, 1).Value <> Empty
'pega o nome atual
TextoCelula = ActiveSheet.Cells(linha, 1).Value
'quebra a palavra atual pela esquerda conforme a quantidade de letras digitadas e compara com o texto digitado
If InStr(UCase(TextoCelula), UCase(textoDigitado)) > 0 Then
'se a comparação for igual será adicionado no formulario
ListBox1.AddItem ActiveSheet.Cells(linha, 1)
End If
linha = linha + 1
Wend
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("C18").Value = Empty Then
Range("C18").Value = "Faça a busca por endereço aqui"
Call ClearReportFiltering

 Else
 End If
End Sub

Clearreportfiltering is .. Macro to . Clearallfilter in Fileds in TD (That’s the way I found it for now)

Answer 1

As stated in the comment, the desired code is the from this Soen link

Sample Data

For this Example Table:

Upshot

This is the expected result:

Code

Option Explicit

Sub FilterCstomers()
'https://stackoverflow.com/questions/42929493/filter-items-with-certain-text-in-a-pivot-table-using-vba
    Dim PvtTbl      As PivotTable
    Dim PvtItm      As PivotItem
    Dim f           As String
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("tabela")
    
    f = ws.Range("C18")

    ' set the pivot table
    Set PvtTbl = ws.PivotTables("Tabela dinâmica1")

    With PvtTbl.PivotFields("campo")
        .ClearAllFilters

        For Each PvtItm In .PivotItems
            If PvtItm.Name Like "*" & f & "*" Then
                PvtItm.Visible = True
            Else
                PvtItm.Visible = False
            End If
        Next PvtItm
    End With

End Sub

In which the name of the Spreadsheet in the exemlo is tabela, the cell with the filter is C18, the name of the dynamic table is Tabela dinâmica1 and the name of the desired field is campo.

To check the table data, right-click and follow the image below:

Event of Worksheet_change

To change the table filter when changing the cell C18, use the event Worksheet_Change, where it should be placed inside the worksheet where the data is. In my case the Worksheet tabela or Planilha3:

Code

On Soen’s link, the difference between Shai Rado’s code for the jeffreyweir code. There are steps to disable automatic cell calculations, which can cause slowness. Especially if you are inside the event Worksheet_Change. For more optimization information, please refer to Cpearson.

Private Sub Worksheet_Change(ByVal Target As Range)
    'https://stackoverflow.com/questions/42929493/filter-items-with-certain-text-in-a-pivot-table-using-vba
    Dim PvtTbl      As PivotTable
    Dim PvtItm      As PivotItem
    Dim f           As String

    On Error GoTo Sair
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
        ' set the pivot table
        Set PvtTbl = PivotTables("Tabela dinâmica1")
        PvtTbl.ManualUpdate = True
    If Target.Address = "$C$18" And Target = vbNullString Then
        PvtTbl.PivotFields("campo").ClearAllFilters
        Target = "Faça a busca por endereço aqui"
    ElseIf Target.Address = "$C$18" And Target <> vbNullString Then
        f = Target.Value


        With PvtTbl.PivotFields("campo")
            .ClearAllFilters

            For Each PvtItm In .PivotItems
                If PvtItm.Name Like "*" & f & "*" Then
                    PvtItm.Visible = True
                Else
                    PvtItm.Visible = False
                End If
            Next PvtItm
        End With

    End If
Sair:
    Set PvtTbl = PivotTables("Tabela dinâmica1")
    PvtTbl.ManualUpdate = False
    Debug.Print Err.Description
    On Error GoTo 0
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub