Filtro em listbox com array vba excel2003

Question

Boa tarde Pessoal.

Estou monatndo uma planilha de meus jogos. No form que mostra os jogos, dicas, etc, coloquei um filtro primário com 4 botões. Eles filtram os 3 tipos e o 4 é de tudo junto. Gostaria de adicionar um filtro por palavra, que filtrasse o array e criasse um novo array apenas com os itens que contivessem o que digitei no textbox.

exemplo: se eu digitar "the" no textbox ele carregaria a listbox com o array de filtro que contivesse em qualquer das 3 colunas  o texto "the"

Name                                                    Cod                      Regiao

The world is big                                   RZZDER                   PAL

super tennis                                         YGTHE6                  PAL

Mario Kart                                            78YXCP                   ThE

Tentei utilizar o seguinte código, mas sem sucesso:

Private Sub FiltroArrays()
Dim ub, ubf, n As Integer
Dim Busca, Expr0, Expr1, Expr2 As String

Select Case Filtro1
Case "Todos"

Case "Jogos"

ubf = 0
ub = UBound(MyArray)
Busca = TextBox1.Value

For n = 0 To ub
Expr0 = MyArray(n, 0)
Expr1 = MyArray(n, 1)
Expr2 = MyArray(n, 2)
If (InStr(1, Busca, Expr0) > 0) Or (InStr(1, Busca, Expr1) > 0) Or (InStr(1, Busca, Expr2) > 0) Then
ubf = ubf + 1
ReDim FiltroArray(ubf, 2)
FiltroArray(ubf, 0) = MyArray(n, 0)
FiltroArray(ubf, 1) = MyArray(n, 1)
FiltroArray(ubf, 2) = MyArray(n, 2)

End If

Next n
ListBox1.List() = FiltroArray()

Case "WiiWares"

Case "Aplicativos"

End Select
   
End Sub

************************

Segue o codigo do form Completo:

Dim n As Integer
Dim Filtro1 As String
Dim nmyarray As Long
Dim MyArray()
Dim MyArray1()
Dim MyArray2()
Dim MyArrayF()
Dim FiltroArray()

Private Sub CommandButton8_Click()
FiltroArrays

End Sub

Private Sub CommandButtonA1_Click()
OrientaBotao (1)
PreencheFinal ("Todos")
End Sub

Private Sub CommandButtonA2_Click()
OrientaBotao (2)
PreencheFinal ("Jogos")
End Sub

Private Sub CommandButtonA3_Click()
OrientaBotao (3)
PreencheFinal ("Wads")
End Sub

Private Sub CommandButtonA4_Click()
OrientaBotao (4)
PreencheFinal ("Aplicativos")
End Sub

Private Sub OrientaBotao(bu)

Select Case bu
Case 1
Filtro1 = "Todos"
Case 2
Filtro1 = "Jogos"
Case 3
Filtro1 = "WiiWares"
Case 4
Filtro1 = "Aplicativos"
End Select

For x = 1 To 4 'laço repete ação até variável limite. X é variável início e incrementada
Controls("CommandButtonA" & x).Enabled = True
Next x 'repete o laço se não chegou ainda no limite
Controls("CommandButtonA" & bu).Enabled = False
End Sub

Private Sub PreencheFinal(parametro)
Dim nLast As Long
Dim nJogos, nWads, nAplic, nTodos As Long

 With ThisWorkbook.Sheets("Jogos")
    nLast = .Cells(.Rows.Count, "A").End(xlUp).Row 'Ler última célula preenchida da coluna A e atribuir a nLast.
    nJogos = nLast - 3
    ReDim MyArray(nJogos, 2)
    For n = 3 To nLast
       If .Cells(n, "A").Value <> vbNullString Then
       n2 = n - 3
       MyArray(n2, 0) = .Cells(n, "A")
       MyArray(n2, 1) = .Cells(n, "B")
       MyArray(n2, 2) = .Cells(n, "C")
      End If
    Next n
 End With

   With ThisWorkbook.Sheets("Wads-VCs")
    nLast = .Cells(.Rows.Count, "A").End(xlUp).Row 'Ler última célula preenchida da coluna A e atribuir a nLast.
    nWads = nLast - 3
    ReDim MyArray1(nWads, 2)
    For n = 3 To nLast
       If .Cells(n, "A").Value <> vbNullString Then
       n2 = n - 3
       MyArray1(n2, 0) = .Cells(n, "A")
       MyArray1(n2, 1) = .Cells(n, "B")
       MyArray1(n2, 2) = .Cells(n, "C")
       End If
    Next n
   
 End With
   
   With ThisWorkbook.Sheets("Aplicativos")
    nLast = .Cells(.Rows.Count, "A").End(xlUp).Row 'Ler última célula preenchida da coluna A e atribuir a nLast.
    nAplic = nLast - 3
    ReDim MyArray2(nAplic, 2)
    For n = 3 To nLast
       If .Cells(n, "A").Value <> vbNullString Then
       n2 = n - 3
       MyArray2(n2, 0) = .Cells(n, "A")
       MyArray2(n2, 1) = .Cells(n, "B")
       MyArray2(n2, 2) = .Cells(n, "C")
       End If
    Next n
   
    End With
   
    nTodos = nJogos + nWads + nAplic + 2

'unir arrays 0, 1, 2 no array F
 
 ReDim MyArrayF(nTodos, 2)
 lbf = LBound(MyArrayF)
 ubf = UBound(MyArrayF)
 
   lb = LBound(MyArray) 'indice menor myarray
   ub = UBound(MyArray) 'indice maior myarray
   ub1 = UBound(MyArray1) 'indice maior myarray1
   ub2 = UBound(MyArray2) 'indice maior myarray2
  
   For n = 0 To ub
   MyArrayF(n, 0) = MyArray(n, 0)
   MyArrayF(n, 1) = MyArray(n, 1)
   MyArrayF(n, 2) = MyArray(n, 2)
   Next n
  
  
   For n = 0 To ub1
   n2 = n + ub + 1
   MyArrayF(n2, 0) = MyArray1(n, 0)
   MyArrayF(n2, 1) = MyArray1(n, 1)
   MyArrayF(n2, 2) = MyArray1(n, 2)
   Next n
  
  For n = 0 To ub2
   n2 = n + ub + ub1 + 2
   MyArrayF(n2, 0) = MyArray2(n, 0)
   MyArrayF(n2, 1) = MyArray2(n, 1)
   MyArrayF(n2, 2) = MyArray2(n, 2)
   Next n

Select Case parametro
Case "Todos"
ListBox1.List() = MyArrayF
Case "Jogos"
ListBox1.List() = MyArray
Case "Wads"
ListBox1.List() = MyArray1
Case "Aplicativos"
ListBox1.List() = MyArray2
End Select

End Sub

Private Sub FiltroArrays()
Dim ub, ubf, n As Integer
Dim Busca, Expr0, Expr1, Expr2 As String

Select Case Filtro1
Case "Todos"

Case "Jogos"

ubf = 0
ub = UBound(MyArray)
Busca = TextBox1.Value

For n = 0 To ub
Expr0 = MyArray(n, 0)
Expr1 = MyArray(n, 1)
Expr2 = MyArray(n, 2)
If (InStr(1, Busca, Expr0) > 0) Or (InStr(1, Busca, Expr1) > 0) Or (InStr(1, Busca, Expr2) > 0) Then
ubf = ubf + 1
ReDim FiltroArray(ubf, 2)
FiltroArray(ubf, 0) = MyArray(n, 0)
FiltroArray(ubf, 1) = MyArray(n, 1)
FiltroArray(ubf, 2) = MyArray(n, 2)

End If

Next n
ListBox1.List() = FiltroArray()

Case "WiiWares"

Case "Aplicativos"

End Select
   
   
   
   
End Sub

Conto com a ajuda de vcs.

Desde já Obrigado.

Answer 1

Bah gente,

Acabei conseguindo mais ou menos o que queria, fui corrigindo conforme os erros iam aparecendo.

Mas ficaram algumas duvidas, tipo li em vários sites da internet que arrays aceitavam valores negativos tipo:

Dim myarray(-13, 32)

E no site que mais encontrei informações estava assim declarado alguns exemplos de array.

mas fiz uma gambiarrinha com if para corrigir isto.

Se alguém possuir alguma melhoria para sugerir aceito de todo coração.

Abraços a todos e um ótimo fim de Domingo.

P.S.: Segue meu código

Dim n As Integer
Dim Filtro1 As String
Dim nmyarray As Long
Dim MyArray()
Dim MyArray1()
Dim MyArray2()
Dim MyArrayF()
Dim FiltroArray()

Private Sub UserForm_Activate()
Filtro1 = "Todos"
PreencheFinal (Filtro1)

Private Sub CommandButtonA1_Click()
OrientaBotao (1)
PreencheFinal ("Todos")
FiltroArrays
End Sub

Private Sub CommandButtonA2_Click()
OrientaBotao (2)
PreencheFinal ("Jogos")
FiltroArrays
End Sub

Private Sub CommandButtonA3_Click()
OrientaBotao (3)
PreencheFinal ("Wads")
FiltroArrays
End Sub

Private Sub CommandButtonA4_Click()
OrientaBotao (4)
PreencheFinal ("Aplicativos")
FiltroArrays
End Sub

Private Sub TextBox1_Keyup(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
   If KeyCode = 13 Then
    FiltroArrays
    MsgBox "deu enter"
   Else
    FiltroArrays
   End If
End Sub

Private Sub OrientaBotao(bu)

Select Case bu
Case 1
Filtro1 = "Todos"
Case 2
Filtro1 = "Jogos"
Case 3
Filtro1 = "Wads"
Case 4
Filtro1 = "Aplicativos"
End Select

For x = 1 To 4 'laço repete ação até variável limite. X é variável início e incrementada
Controls("CommandButtonA" & x).Enabled = True
Next x 'repete o laço se não chegou ainda no limite
Controls("CommandButtonA" & bu).Enabled = False
End Sub

 

Private Sub PreencheFinal(parametro)
Dim nLast As Long
Dim nJogos, nWads, nAplic, nTodos As Long

 
 With ThisWorkbook.Sheets("Jogos")
    nLast = .Cells(.Rows.Count, "A").End(xlUp).Row 'Ler última célula preenchida da coluna A e atribuir a nLast.
    nJogos = nLast - 3
    ReDim MyArray(nJogos, 2)
    For n = 3 To nLast
       If .Cells(n, "A").Value <> vbNullString Then
       n2 = n - 3
       MyArray(n2, 0) = .Cells(n, "A")
       MyArray(n2, 1) = .Cells(n, "B")
       MyArray(n2, 2) = .Cells(n, "C")
      End If
    Next n
 End With

   With ThisWorkbook.Sheets("Wads-VCs")
    nLast = .Cells(.Rows.Count, "A").End(xlUp).Row 'Ler última célula preenchida da coluna A e atribuir a nLast.
    nWads = nLast - 3
    ReDim MyArray1(nWads, 2)
    For n = 3 To nLast
       If .Cells(n, "A").Value <> vbNullString Then
       n2 = n - 3
       MyArray1(n2, 0) = .Cells(n, "A")
       MyArray1(n2, 1) = .Cells(n, "B")
       MyArray1(n2, 2) = .Cells(n, "C")
       End If
    Next n
   
 End With
   
   With ThisWorkbook.Sheets("Aplicativos")
    nLast = .Cells(.Rows.Count, "A").End(xlUp).Row 'Ler última célula preenchida da coluna A e atribuir a nLast.
    nAplic = nLast - 3
    ReDim MyArray2(nAplic, 2)
    For n = 3 To nLast
       If .Cells(n, "A").Value <> vbNullString Then
       n2 = n - 3
       MyArray2(n2, 0) = .Cells(n, "A")
       MyArray2(n2, 1) = .Cells(n, "B")
       MyArray2(n2, 2) = .Cells(n, "C")
       End If
    Next n
   
    End With
   
    nTodos = nJogos + nWads + nAplic + 2

'unir arrays 0, 1, 2 no array F
 
 ReDim MyArrayF(nTodos, 2)
 lbf = LBound(MyArrayF)
 ubf = UBound(MyArrayF)
 
   lb = LBound(MyArray) 'indice menor myarray
   ub = UBound(MyArray) 'indice maior myarray
   ub1 = UBound(MyArray1) 'indice maior myarray1
   ub2 = UBound(MyArray2) 'indice maior myarray2
  
   For n = 0 To ub
   MyArrayF(n, 0) = MyArray(n, 0)
   MyArrayF(n, 1) = MyArray(n, 1)
   MyArrayF(n, 2) = MyArray(n, 2)
   Next n
  
  
   For n = 0 To ub1
   n2 = n + ub + 1
   MyArrayF(n2, 0) = MyArray1(n, 0)
   MyArrayF(n2, 1) = MyArray1(n, 1)
   MyArrayF(n2, 2) = MyArray1(n, 2)
   Next n
  
  For n = 0 To ub2
   n2 = n + ub + ub1 + 2
   MyArrayF(n2, 0) = MyArray2(n, 0)
   MyArrayF(n2, 1) = MyArray2(n, 1)
   MyArrayF(n2, 2) = MyArray2(n, 2)
   Next n

Select Case parametro
Case "Todos"
ListBox1.List() = MyArrayF
Case "Jogos"
ListBox1.List() = MyArray
Case "Wads"
ListBox1.List() = MyArray1
Case "Aplicativos"
ListBox1.List() = MyArray2
End Select

End Sub

 

Private Sub FiltroArrays()

Dim ub, ubf As Long
Dim Busca, Campo0, Campo1, Campo2 As String

Select Case Filtro1
Case "Jogos"
ub = UBound(MyArray)
ubf = 0
Busca = TextBox1.Value

For n = 0 To ub
Campo0 = MyArray(n, 0)
Campo1 = MyArray(n, 1)
Campo2 = MyArray(n, 2)
If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
ubf = ubf + 1
End If
Next n
If ubf <= 0 Then
ubf = 0
Else
ubf = ubf - 1
End If
ReDim FiltroArray(ubf, 2)
ubf = 0

For n = 0 To ub
Campo0 = MyArray(n, 0)
Campo1 = MyArray(n, 1)
Campo2 = MyArray(n, 2)
If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
FiltroArray(ubf, 0) = MyArray(n, 0)
FiltroArray(ubf, 1) = MyArray(n, 1)
FiltroArray(ubf, 2) = MyArray(n, 2)
ubf = ubf + 1
End If
Next n

ListBox1.List() = FiltroArray

 

Case "Todos"
ub = UBound(MyArrayF)
ubf = 0
Busca = TextBox1.Value

For n = 0 To ub
Campo0 = MyArrayF(n, 0)
Campo1 = MyArrayF(n, 1)
Campo2 = MyArrayF(n, 2)
If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
ubf = ubf + 1
End If
Next n
If ubf <= 0 Then
ubf = 0
Else
ubf = ubf - 1
End If
ReDim FiltroArray(ubf, 2)
ubf = 0

For n = 0 To ub
Campo0 = MyArrayF(n, 0)
Campo1 = MyArrayF(n, 1)
Campo2 = MyArrayF(n, 2)
If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
FiltroArray(ubf, 0) = MyArrayF(n, 0)
FiltroArray(ubf, 1) = MyArrayF(n, 1)
FiltroArray(ubf, 2) = MyArrayF(n, 2)
ubf = ubf + 1
End If
Next n

ListBox1.List() = FiltroArray

 

Case "Wads"
ub = UBound(MyArray1)
ubf = 0
Busca = TextBox1.Value

For n = 0 To ub
Campo0 = MyArray1(n, 0)
Campo1 = MyArray1(n, 1)
Campo2 = MyArray1(n, 2)
If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
ubf = ubf + 1
End If
Next n
If ubf <= 0 Then
ubf = 0
Else
ubf = ubf - 1
End If
ReDim FiltroArray(ubf, 2)
ubf = 0

For n = 0 To ub
Campo0 = MyArray1(n, 0)
Campo1 = MyArray1(n, 1)
Campo2 = MyArray1(n, 2)
If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
FiltroArray(ubf, 0) = MyArray1(n, 0)
FiltroArray(ubf, 1) = MyArray1(n, 1)
FiltroArray(ubf, 2) = MyArray1(n, 2)
ubf = ubf + 1
End If
Next n

ListBox1.List() = FiltroArray

 

Case "Aplicativos"
ub = UBound(MyArray2)
ubf = 0
Busca = TextBox1.Value

For n = 0 To ub
Campo0 = MyArray2(n, 0)
Campo1 = MyArray2(n, 1)
Campo2 = MyArray2(n, 2)
If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
ubf = ubf + 1
End If
Next n
If ubf <= 0 Then
ubf = 0
Else
ubf = ubf - 1
End If
ReDim FiltroArray(ubf, 2)
ubf = 0

For n = 0 To ub
Campo0 = MyArray2(n, 0)
Campo1 = MyArray2(n, 1)
Campo2 = MyArray2(n, 2)
If (InStr(1, Campo0, Busca, 1) > 0) Or (InStr(1, Campo1, Busca, 1) > 0) Or (InStr(1, Campo2, Busca, 1) > 0) Then
FiltroArray(ubf, 0) = MyArray2(n, 0)
FiltroArray(ubf, 1) = MyArray2(n, 1)
FiltroArray(ubf, 2) = MyArray2(n, 2)
ubf = ubf + 1
End If
Next n

ListBox1.List() = FiltroArray
End Select
End Sub

Answer 2

Bom gente, vou marcar a solução que encontrie como resposta, mas qualquer sugestão estamos ai...

Valeu a todos