Populate AdvancedFilter Criteria from a MultiSelect ListBox

Question

There is a question similar to this one but it does not meet the specifications here.

I have a MultiSelect ListBox and a table which represents an AdvancedFilter criteria.

I want to populate the column "Level" of this table with all the values selected from the ListBox, every value should be in a separate row (OR condition for an AdvancedFilter).

The results I am seeking :

If no item is selected, it should remove the rows added in the table and only populate "<>0".

The code I have written so far does the tricks shown in the 2 first images but and when I deselect all the items it does not work anymore:

 Private Sub ListBox1_LostFocus()

    Dim aArray() As Single
    ReDim aArray(1 To 1) As Single
    With ListBox1
        For I = 0 To .ListCount - 1
            If .Selected(I) Then
            aArray(UBound(aArray)) = .List(I)
            ReDim Preserve aArray(1 To UBound(aArray) + 1) As Single
        End If
        Next I
        End With

 Range(Cells(3, "S"), Cells(UBound(aArray) - 1, "S"))= Application.Transpose(aArray)

End Sub

Has someone already dealt with this issue? Any help would be much appreciated! Thank you so much!

Answer 1

It looks complicated, but it does the job neatly.

Private Sub ListBox1_LostFocus()
'
'is called when you finish selecting items from the ListBox
'

    Dim aArray() As Single
    ReDim aArray(1 To 1) As Single

    'fetch selected items of listbox into aArray
    With ListBox1
        For I = 0 To .ListCount - 1
            If .Selected(I) Then
                aArray(UBound(aArray)) = .List(I)
                ReDim Preserve aArray(1 To UBound(aArray) + 1) As Single
            End If
        Next I
    End With

    'clear old items in the advanced filter's condition table to replace them with those we fetched
    '/!\ if there was more old items than new items, we would need to delete their rows from the table
    Range("Condition[Level]").ClearContents

    'we need to compare the size of the array with the size of the table so that we don't have extra rows
    '(the advanced filter interpretates empty rows as '*' so we absolutely need to get rid of them)
    r = UBound(aArray)
    n = Range("Condition[#Data]").Rows.count


    If UBound(aArray) = 1 Then
        Range("Condition[Level]") = "<>0" 'if nothing is selected, fetch every item meaning numeric and non numeric (more powerful than "*")
        Range("Condition[Serial]") = "*" 'columns to the left of 'Level' are not automatically replicated in the table (contrary to those on the right which gets previous row's) values so they become empty, that's why we need to fill them with the value we want
        Range("Condition[#Data]").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    Else
        Range(Cells(3, "S"), Cells(3 + UBound(aArray) - 2, "S")) = Application.Transpose(aArray)

        If n > r - 1 Then
            [Condition].Rows(r & ":" & n).Select ' r+1 to skip the headers' row
            [Condition].Rows(r & ":" & n).Delete 'doing a select before the delete prevents a bug which would delete the entire rows of the sheet
        End If

    End If

If you have an improvement to my code, i will gladly take it! I am slightly new to VBA, i'm sure there are tons of ways to improve it.

If you have a request similar to this issue, feel free to ask any question.