Search code examples
excelvbacomboboxlistbox

ComboBox change event result in ListBox

This is an updated question from here. Answer from this post works perfectly especially for the cascaded combobox change. I am just having trouble with displaying the result in ListBox1 according to all that matched in Sheet1 in the last change event.

This is the raw data:

Col. A    Col. B   Col. G    Col. J    Col. L
YEAR    || NAME || COLOR || MONTH    || SHAPE
2023    || LINA || GREEN || AUGUST   || HEART
2023    || LINA || GREEN || SEPTEMBER|| CIRCLE
2024    || GARY || GREEN || SEPTEMBER|| DIAMOND
2024    || GARY || GREEN || SEPTEMBER|| RECTANGLE
2024    || GARY || RED   || AUGUST   || OVAL
2023    || GARY || RED   || AUGUST   || RECTANGLE
2023    || GARY || GREEN || AUGUST   || SQUARE
2024    || GARY || GREEN || SEPTEMBER|| STAR
2024    || TOM  || RED   || AUGUST   || HEART
2024    || TOM  || RED   || SEPTEMBER|| CIRCLE
2024    || TOM  || RED   || SEPTEMBER|| DIAMOND
2024    || TOM  || YELLOW|| SEPTEMBER|| OVAL
2024    || TOM  || YELLOW|| OCTOBER  || RECTANGLE
2024    || TOM  || YELLOW|| OCTOBER  || CIRCLE
2024    || TOM  || YELLOW|| OCTOBER  || SQUARE
2024    || TOM  || YELLOW|| OCTOBER  || STAR
2024    || TOM  || YELLOW|| OCTOBER  || STAR
2024    || TOM  || BLUE  || OCTOBER  || SQUARE

Image of raw data (blanks here have purpose): raw image

Code for the change event:

Private Sub ComboBox4_Change()
    If Not ComboBox4.Value = "" Then
        Dim ws As Worksheet
        Dim rcell As Range, Key
        Dim arrData, arrList(), i As Long, j As Long
        Set ws = Worksheets("Sheet1")
        arrData = ws.Range("A1:L" & ws.Cells(Rows.count, "B").End(xlUp).Row)
        ReDim arrList(1 To 2, 1 To UBound(arrData, 2))
        For j = 1 To UBound(arrData, 2)
            arrList(1, j) = arrData(1, j)
        Next
        For i = 2 To UBound(arrData)
            If arrData(i, 2) = ComboBox1.Value And arrData(i, 1) = CStr(ComboBox2.Value) _
                And arrData(i, 7) = ComboBox3.Value And arrData(i, 10) = ComboBox4.Value Then
                For j = 1 To UBound(arrData, 2)
                    arrList(2, j) = arrData(i, j)
                Next
                Exit For
            End If
        
        Next
        With Me.ListBox1
            .ColumnHeads = False
            .ColumnWidths = "35,35,0,0,0,0,40,0,0,50,0,50"
            .ColumnCount = UBound(arrData, 2)
            .List = arrList
        End With
    End If
End Sub

As you can see, using the change event code above returns 1 row of data only (if I choose Tom in 2024 with Yellow color and October month) when it should return more rows to display in ListBox1 because it has more than one shape (it is fine if shape is repeating in Sheet1): listbox displays one row only

My desired output is this (when manually filtered in Sheet1): desired output

What should be changed in the change event code to correct this. Thanks for your help.

Solution

  • Please, try the next adapted code:

    Private Sub ComboBox4_Change()
    If Not ComboBox4.value = "" Then
        Dim ws As Worksheet, rng As Range, count As Long, K As Long
        Dim arrData, arrList(), i As Long, j As Long
        Set ws = Worksheets("Sheet1")
        
        Set rng = ws.Range("A1:L" & ws.cells(rows.count, "B").End(xlUp).Row)
        arrData = rng.value

        'determine the necessary number of final array rows:
        count = WorksheetFunction.CountIfs(rng.Columns(1), CStr(ComboBox2.value), rng.Columns(2), ComboBox1.value, rng.Columns(7), ComboBox3.value, rng.Columns(10), ComboBox4.value)
        ReDim arrList(1 To count + 1, 1 To UBound(arrData, 2))
        For j = 1 To UBound(arrData, 2)
            arrList(1, j) = arrData(1, j) 'the header
        Next
        K = 1
        For i = 2 To UBound(arrData)
            If arrData(i, 2) = ComboBox1.value And arrData(i, 1) = CStr(ComboBox2.value) _
                And arrData(i, 7) = ComboBox3.value And arrData(i, 10) = ComboBox4.value Then
                K = K + 1
                For j = 1 To UBound(arrData, 2)
                    arrList(K, j) = arrData(i, j) 'matching data
                Next
            End If
        
        Next
        With Me.ListBox1
            .ColumnHeads = False
            .ColumnWidths = "35,35,0,0,0,0,40,0,0,50,0,50"
            .ColumnCount = UBound(arrData, 2)
            .List = arrList
        End With
    End If
End Sub