criação de filtro em um list box

Question

bom dia estou tentando criar um formulario de pesquisa com list box mais um filtro no text box, mas estou tendo dificuldades.

"""
Option Explicit

Dim lo As ListObject
Private planilha As String
Private tabela As String
Private TextoDigitado As String

Private Sub btncarrega_Click()
   If cbpesquisa.Value = "Cidadão" Then
                planilha = "Cidadão"
                tabela = "Cidadao"
                Else
           End
           
        End If
    Dim Values As Variant
    
    Set lo = ThisWorkbook.Worksheets(planilha).ListObjects(tabela)
    
    ListBox1.ColumnCount = lo.ListColumns.Count
    Values = lo.DataBodyRange.Text
'    ListBox1.List = Values
    
    Debug.Print lo.DataBodyRange.Address(, , , 1)
    ListBox1.RowSource = lo.DataBodyRange.Address(, , , 1)
    
    UpdateCW
    txtpesquisa.Enabled = True
   
End Sub

Private Sub btnpesquisa_Click()

End Sub

Private Sub btnSair_Click()
    Unload Me
End Sub

Sub UpdateCW()
    Dim CW As Variant
    
    'ListBox1.ColumnWidths = "200;200;200;200;200"
    CW = lo.HeaderRowRange.Offset(-1).Value2
    CW = Application.Transpose(CW)
    CW = Application.Transpose(CW)
    
    ListBox1.ColumnWidths = Join(CW, ";")
End Sub

Private Sub txtpesquisa_Change()
 TextoDigitado = txtpesquisa.Text
 Call PreencheLista
End Sub

Private Sub UserForm_Initialize()
Me.cbpesquisa.RowSource = "cbo!r4:r17"
txtpesquisa.Enabled = False
End Sub

'       [Excel Avançado - Macros e Vba]

Private Sub TextBox1_Change()
    TextoDigitado = TextBox1.Text
    Call PreencheLista
End Sub

Private Sub PreencheLista()
    Dim ws As Worksheet
    Dim tb As ListObjects
    Dim i As Integer
    Dim TextoCelula As String
    Set ws = ThisWorkbook.Worksheets(planilha).ListObjects(tabela)
    i = 1
    ListBox1.Clear
    With ws
        While .Cells(i, 1).Value <> Empty
            TextoCelula = .Cells(i, 1).Value
            If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then
                ListBox1.AddItem .Cells(i, 1)
            End If
            i = i + 1
        Wend
    End With
End Sub

Private Sub UserForm_Terminate()
txtpesquisa.Enabled = False
End Sub""
alguem saberia me ajudar com esse erro

Answer 1

Option Explicit

Dim lo As ListObject
Private planilha As String
Private tabela As String
Private TextoDigitado As String

Private Sub btncarrega_Click()

   If cbpesquisa.Value = "Cidadão" Then
                planilha = "Cidadão"
                tabela = "Cidadao"
                Else
           End
           
        End If

    Dim Values As Variant
    
    Set lo = ThisWorkbook.Worksheets(planilha).ListObjects(tabela)
    
    ListBox1.ColumnCount = lo.ListColumns.Count
    Values = lo.DataBodyRange.Text
'    ListBox1.List = Values
    
    Debug.Print lo.DataBodyRange.Address(, , , 1)
    ListBox1.RowSource = lo.DataBodyRange.Address(, , , 1)
    
    UpdateCW
    txtpesquisa.Enabled = True
   
End Sub

Private Sub btnpesquisa_Click()

End Sub

Private Sub btnSair_Click()
    Unload Me
End Sub

Sub UpdateCW()
    Dim CW As Variant
    
    'ListBox1.ColumnWidths = "200;200;200;200;200"
    CW = lo.HeaderRowRange.Offset(-1).Value2
    CW = Application.Transpose(CW)
    CW = Application.Transpose(CW)
    
    ListBox1.ColumnWidths = Join(CW, ";")
End Sub


Private Sub cbpesquisa_Change()
   If cbpesquisa.Value = "Cidadão" Then
                planilha = "Cidadão"
                tabela = "Cidadao"
                Else
           End
           
        End If
End Sub

Private Sub txtpesquisa_Change()
If Me.txtpesquisa.Text <> "" Then
    TextoDigitado = TextBox1.Text
    If cbpesquisa.ListIndex >= 0 Then
    Call PreencheLista
    End If
    
    Else
    Me.ListBox1.Clear
    
    End If
End Sub


Private Sub UserForm_Initialize()
Me.cbpesquisa.RowSource = "cbo!r4:r17"
txtpesquisa.Enabled = False
End Sub


'       [Excel Avançado - Macros e Vba]


Private Sub TextBox1_Change()
If Me.TextBox1.Text <> "" Then
    TextoDigitado = TextBox1.Text
    If cbpesquisa.ListIndex >= 0 Then
    Call PreencheLista
    End If
    
    Else
    Me.ListBox1.Clear
    
    End If
End Sub

Private Sub PreencheLista()
    Dim ws As Worksheet
    Dim tb As ListObjects
    Dim i As Integer
    Dim TextoCelula As String
    Dim linhaListBox As Long
    Set ws = ThisWorkbook.Worksheets(planilha)
    Set lo = ThisWorkbook.Worksheets(planilha).ListObjects(tabela)
    
    ListBox1.ColumnCount = lo.ListColumns.Count
    i = 1
    ListBox1.Clear
    linhaListBox = 0
    With ws
        While .Cells(i, 1).Value <> Empty
            TextoCelula = .Cells(i, 1).Value
            If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then
                ListBox1.AddItem .Cells(i, 1).Value
               ' ListBox1.List(linhaListBox, 1) = .Cells(i, 2).Value
               ' ListBox1.List(linhaListBox, 2) = .Cells(i, 3).Value
                'linhaListBox = linhaListBox + 1
            End If
            i = i + 1
        Wend
    End With
End Sub

Private Sub UserForm_Terminate()
txtpesquisa.Enabled = False
End Sub

---

A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz [e-mail]

Answer 2

https://youtu.be/d7C972T19cM

---

A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz [e-mail]

Answer 3

https://youtu.be/IIEu_ES66_E

Answer 4

https://youtu.be/k__GdinXyKA

---

A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz [e-mail]

Answer 5

BOM DIA ANDERSON GOSTEI DA SUA EXPLICAÇÃO SÓ QUE NÃO RESOLVEU O MEU PROBLEMA, 

RETIREI PARTES DOS CÓDIGOS QUE ESTAVA CONFUSO ORGANIZEI AS VARIÁVEL EM UM LUGAR SÓ PARA FICAR COM UM INTENDIMENTO MELHOR.

"

Option Explicit
Dim CW As Variant
Dim Values As Variant
Dim ws As Worksheet
Dim tb As ListObject
Dim i As Integer
Dim TextoCelula As String
Dim linhaListBox As Long
Private planilha As String
Private tabela As String
Private TextoDigitado As String


Private Sub btncarrega_Click()
   If cbpesquisa.Value = "Cidadão" Then
                planilha = "Cidadão"
                tabela = "Cidadao"
                Else
            
           End
           
        End If
        ' A COMPLEMENTO PARA O CODIGO IF ACIMA.
    
    Set tb = ThisWorkbook.Worksheets(planilha).ListObjects(tabela)
    
    ListBox1.ColumnCount = tb.ListColumns.Count
    Values = tb.DataBodyRange.Text
    Debug.Print tb.DataBodyRange.Address(, , , 1)
    ListBox1.RowSource = tb.DataBodyRange.Address(, , , 1)
    
    UpdateCW
    txtpesquisa.Enabled = True
   
End Sub


Private Sub btnSair_Click()
    Unload Me
End Sub



Sub UpdateCW()
    CW = tb.HeaderRowRange.Offset(-1).Value2
    CW = Application.Transpose(CW)
    CW = Application.Transpose(CW)
    ListBox1.ColumnWidths = Join(CW, ";")
End Sub

Private Sub txtpesquisa_Change()
 TextoDigitado = txtpesquisa.Text
 Call PreencheLista
End Sub


Private Sub UserForm_Initialize()
Me.cbpesquisa.RowSource = "cbo!r4:r17"
txtpesquisa.Enabled = False
End Sub

Private Sub PreencheLista()
    Set ws = ThisWorkbook.Worksheets(planilha)
    Set tb = ThisWorkbook.Worksheets(planilha).ListObjects(tabela)
    i = 1
    ListBox1.Clear
    linhaListBox = 0
    With ws
        While .Cells(i, 1).Value <> Empty
            TextoCelula = .Cells(i, 1).Value
           If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then
                ListBox1.AddItem .Cells(i, 1)
            End If
           i = i + 1
        Wend
    End With
End Sub

Private Sub UserForm_Terminate()
txtpesquisa.Enabled = False
End Sub

""

Answer 6

https://studio.youtube.com/video/KgA_WYrODzA/edit

---

A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz [e-mail]