USERFORM: I can not remove items from my ListBox (Error 80004005)

1

I have a ListBox in a UserForm that "rebuilds" based on a TextBox that I use as a filter. The idea is to bring all the items to the list with RowSource and remove all items that do not contain text from the TextBox. However, when testing the system, I run into error 80004005 at 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 do not understand what I'm doing wrong. Can anyone help me?

    
asked by anonymous 11.04.2017 / 21:43

2 answers

1

When you populate a ListBox with the RowSource property, you can not edit the items within the list, especially removing an item. You would need to rebuild the list with the .AddItem statement to "convert" the list into a box with multiple items, which can be moved, changed, and deleted. I suggest the following for your case:

  • Name an array variable to record your original RpwSource.
  • Empty your ListBox.
  • 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
    
        
    19.04.2017 / 01:34
    2

    I could not find a Microsoft font talking about it, but when you set the RowSource property of a ListBox , you can not remove or add items to the list. So what you can do is always popular the list according to what was typed.

    Here's 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
    
        
    18.04.2017 / 13:30