USERFORM: I can’t remove items from my Listbox (Error 80004005)

Question

I have a Listbox in a Userform that I "reconstruct" 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 Textbox text. However, when testing the system, I come across the 80004005 error on the 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 someone help me?

Answer 1

I couldn’t find a source Microsoft talking about it, but when you define the property RowSource of a ListBox, cannot remove or add items in the list. So what you can do is always popular the list according to what was typed.

Follow an example using the same RowSource that 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

Answer 2

By popular a Listbox with the Rowsource property you cannot edit the items within the list, especially removing an item. You would need to reconstruct the list with the statement .AddItem to "convert" the list into a box with several items, which can be moved, changed and deleted. I suggest to thest case the following:

1. Name a matrix variable to record your original Rpwsource.
2. Empty your Listbox.
3. Repopulate it only with the items that match 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