Filter PivotTable by word in a cell

2

This other one just below the same post from the link above .. Is there a running difference? ... link

Is there any way to speed up the execution of any of these codes .. Type binary format ... or change n even 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 worksheet "heavy" ... I would if it were not with a button it was to give enter in cell "C18" .. (At the end of each word search).

@danieltakeshi, I would like that when deleting the cell .. ("C18") = Empty .. appear in the place "Search by address here" .. execute ClearAllFilters ... in case the cell ("C18") whenever you do not have a search to do, you will have "Search by address here".

But the filter has behaved this way with the code ... select the last item of the filter with text search that does not have between 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 on Fileds in TD (It was the form I found for now)

    
asked by anonymous 16.06.2018 / 19:54

1 answer

1

As mentioned in the comment, the desired code is this SOen link

Example Data

For this example table:

Result

Thisistheexpectedresult:

Code

OptionExplicitSubFilterCstomers()'https://stackoverflow.com/questions/42929493/filter-items-with-certain-text-in-a-pivot-table-using-vbaDimPvtTblAsPivotTableDimPvtItmAsPivotItemDimfAsStringDimwsAsWorksheetSetws=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

Where the name of the worksheet in the example is tabela , the cell with the filter is C18 , the name of the pivot 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:

Worksheet_ChangeEvent

TochangethetablefilterbychangingtheC18cell,usetheWorksheet_Changeevent,whichmustbeplacedinsidetheworksheetwherethedataislocated.Inmycase,theWorksheettabelaorPlanilha3:

Code

IntheSOenlink,thedifferencebetweentheShaiRadocodeforthejeffreyweircode.Therearestepsindisablingautomaticcellcalculations,whichcancauseslowness.EspeciallyifyouareinsidetheWorksheet_Changeevent.Formoreoptimizationinformation,referto 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
    
20.06.2018 / 14:12