Advanced Filter

It is possible to perform an advanced filter with the SOA Ralph code, take the accent of the word with the ExtendOffice code, and ignore lowercase or uppercase by transforming uppercase with Ucase()

The filter is performed on a form named Userform1, a text box named TextBox1, and a list called ListBox1.

Code

PrivateSubTextbox1_Change()'https://stackoverflow.com/a/42880069/7690982DimiAsLongDimarrListAsVariantDimwsAsWorksheetSetws=ThisWorkbook.Worksheets("Nome da Planilha")

    Me.ListBox1.Clear
    If ws.Range("A" & ws.Rows.Count).End(xlUp).Row > 1 And Trim(Me.TextBox1.Value) <> vbNullString Then
        arrList = ws.Range("A1:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row).Value2
        For i = LBound(arrList) To UBound(arrList)
            If InStr(1, UCase(StripAccent(CStr(arrList(i, 1)))), UCase(StripAccent(Trim(Me.TextBox1.Value))), vbTextCompare) Then
                Me.ListBox1.AddItem arrList(i, 1)
            End If
        Next i
    End If
    If Me.ListBox1.ListCount = 1 Then Me.ListBox1.Selected(0) = True

End Sub

Public Function StripAccent(thestring As String)
    'https://www.extendoffice.com/documents/excel/707-excel-replace-accented-characters.html
    Dim A As String * 1
    Dim B As String * 1
    Dim i As Integer
    Const AccChars = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
    Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
    For i = 1 To Len(AccChars)
        A = Mid(AccChars, i, 1)
        B = Mid(RegChars, i, 1)
        thestring = Replace(thestring, A, B)
    Next
    StripAccent = thestring
End Function

Result

The letter is typed in TextBox1 and the filter is performed, as shown below:

EDIT:

Multiselect

TherearethreeMultiselectoptions:

• ListBox.MultiSelect=1:Selectonlyoneelement.
• ListBox.MultiSelect=2:Clicktheitemorpressthespacebartoselectmultipleitems
• ListBox.MultiSelect=3:PressShiftandCtrltoselectmultipleitems

Code

Thenthefollowingcodeisusedtochangethesetupsettingswhenstartingtheform.

PrivateSubUserForm_Initialize()'EntreoutroscódigosdeinicializaçãoMe.ListBox1.MultiSelect=1EndSub

PivotTableFilterbutton

ACommandButtonbuttoncanbeaddedandafterthedataischosen,itwillbefilteredinthePivotTable.

Code

ThefunctionIsInArray()ofJimmyPenaofSOenisused.

PrivateSubCommandButton1_Click()DimiAsLong,jAsLongDimPvtTblAsPivotTableDimPvtItmAsPivotItemDimwsAsWorksheetDimarr()AsVariantOnErrorGoToSairWithApplication.EnableEvents=False.ScreenUpdating=False.Calculation=xlCalculationManualEndWithSetws=ThisWorkbook.Sheets("Nome da Planilha")
    Set PvtTbl = ws.PivotTables("Tabela dinâmica1")
    PvtTbl.ManualUpdate = True
    For i = 0 To ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) = True Then
            ReDim Preserve arr(j)
            arr(j) = Me.ListBox1.List(i)
            j = j + 1
        End If
    Next i

    With PvtTbl.PivotFields("campo")
        .ClearAllFilters
        For Each PvtItm In .PivotItems
            If IsInArray(PvtItm.Name, arr) = True Then
                PvtItm.Visible = True
            Else
                PvtItm.Visible = False
            End If
        Next PvtItm
    End With

Sair:
    Set PvtTbl = ws.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

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
'https://stackoverflow.com/a/10952705/7690982
  IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function