USERFORM: I can't remove items from my ListBox (Error 80004005)
I have a ListBox in a UserForm that I" rebuild " based on a TextBox that I use as a filter. The idea is to bring all items to the list with RowSource and remove all items that do not contain text from the TextBox. However, when testing the system, I come across error 80004005 on line ListBox1.RemoveItem x
.
Private Sub FilterBox_Change()
'Restaurar lista original
ListBox1.RowSource = "Customers"
' Consolidate a new cuistomer list based on the filter field text
Dim x As Long
For x = ListBox1.ListCount - 1 To 0 Step -1
If Not UCase(ListBox1.List(x, 0) & ListBox1.List(x, 1)) Like "*" & UCase(FilterBox.Text) & "*" Then
ListBox1.RemoveItem x
End If
Next x
End Sub
I don't understand what I'm doing wrong. Can anyone help me?
2 answers
I couldn't find a font Microsoft talking about this, but when you set the RowSource
property of a ListBox
, it's not possible to remove or add items to the list.
So what you can do is always popular the list according to what was typed.
Follows an example using the same RowSource
you provided in the example:
Private Sub FilterBox_Change()
' Carrega a lista com base no texto digitado
ListBox1.List = CarregarLista(ActiveSheet.Range("Customers"), FilterBox.Value)
End Sub
Private Sub UserForm_Initialize()
' Carrega a lista completa
ListBox1.List = CarregarLista(ActiveSheet.Range("Customers"))
End Sub
' Função que retorna um Array com os nomes de um determinado Range nomeado
Private Function CarregarLista(rngNomes As Range, Optional strPesquisa As String) As String()
Dim rangeCount As Long, cont As Long, nomes() As String
cont = 0
' Atua no range informado no parâmetro
With rngNomes
' Define o tamanho do array com base no tamanho do range
ReDim Preserve nomes(.Rows.Count - 1, .Columns.Count - 1)
' Laço que percorre todas as linhas do Range nomeado
For rangeCount = 1 To .Rows.Count
' Caso algum texto seja informado no parâmetro, carrega a lista filtrada
If strPesquisa <> "" Then
' Se o texto informado for parecido com algum nome do range
If UCase(.Cells(rangeCount, 1) & " " & .Cells(rangeCount, 2)) Like "*" & UCase(strPesquisa) & "*" Then
' Adiciona o nome no array
nomes(cont, 0) = .Cells(rangeCount, 1).Value
nomes(cont, 1) = .Cells(rangeCount, 2).Value
cont = cont + 1
End If
Else
' Adiciona o nome no array
nomes(cont, 0) = .Cells(rangeCount, 1).Value
nomes(cont, 1) = .Cells(rangeCount, 2).Value
cont = cont + 1
End If
Next
End With
' Retorno da lista
CarregarLista = nomes
End Function
When you populate a ListBox with the RowSource property vc fails to edit the items within the list, especially removing an item. Vc would need to rebuild the list with the .AddItem
declaration to "convert" the list into a box with multiple items, which can be moved, changed, and deleted. I suggest for the teuu case the following:
- name a matrix variable to write your original RpwSource.
- empty your ListBox.
- repopulate it only with items that match with your search TextBox.
The code should look something like this:
Private Sub FilterBox_Change()
'Dimensionar variáveis
Dim NovaLista() As String
Dim n As Integer
Dim i As Integer
Dim j As Integer
'Restaurar lista original
ListBox1.RowSource = "Customers"
'Carregar conteúdo da lista em variável matricial:
n = ListBox1.ListCount - 1
ReDim NovaLista(0 To n, 0 To 1)
For i = 0 To n
For j = 0 To 1
NovaLista(i, j) = ListBox1.List(i, j)
Next j
Next i
'Limpar conteúdo da lista
ListBox1.RowSource = Empty
ListBox1.Clear
'Reconstruir lista adcionando apenas itens que batem com o testo pesquisado
j = 0
For i = 0 To n
If UCase(NovaLista(i, 0) & NovaLista(i, 1)) Like "*" & UCase(FilterBox.Text) & "*" Then
ListBox1.AddItem
ListBox1.List(j, 0) = NovaLista(j, 0)
ListBox1.List(j, 1) = NovaLista(j, 1)
j = j + 1
End If
Next i
End Sub