Search code examples
excelvbafiltercomboboxlistbox

Show Filtered Data in Cascaded ComboBoxes and ListBox1

I have here cascading ComboBoxes when filtered, will display properly in ListBox1. Below is my Sheet1 data (please do not mind how they are arranged as they have a purpose and I will be adding more data on these blank cells):

Sheet1 data

Sheet1 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 || 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  || BLUE  || OCTOBER  || SQUARE

Now my challenge is that, ComboBoxes 2-5 are not listing expected data during filter. As you can see below, I filtered it this way but there’s an additional month added in ComboBox 4:

Gary filter

When it should be this month only (when manually filtered in the sheet):

only august month

Also, I did another filter for another name below but ComboBox5 is showing all of the unique shapes instead of Heart only.

all shapes are showing

Expected outcome for ComboBox5 (when manually filtered in the sheet):

should be heart only

This is my code for the cascading ComboBoxes:

Option Explicit
Private Sub ComboBox4_Change()
''''''**************************** Different Tasks Not Equal to No Ticket
  If Not ComboBox4.Value = "" Then
    With Me.ComboBox5
        .Enabled = True
        .BackColor = &HFFFF&
        
        Dim ws As Worksheet
        Dim rcell As Range, Key
        Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
        Set ws = Worksheets("Sheet1")
            
        .Clear
        .Value = vbNullString
        
            For Each rcell In ws.Range("B2", ws.Cells(Rows.count, "B").End(xlUp))
                    If rcell.Offset(0, 0) <> ComboBox1.Value And rcell.Offset(0, -1) <> ComboBox2.Value And rcell.Offset(0, 5) <> ComboBox3.Value And rcell.Offset(0, 8) <> ComboBox4.Value Then
                    Else
                        If Not dic.Exists(rcell.Offset(, 10).Value) Then
                            dic.Add rcell.Offset(, 10).Value, Nothing
                        End If
                    End If
            Next rcell
            For Each Key In dic
                Me.ComboBox5.AddItem Key
            Next
    End With
Else
     With Me.ComboBox5
     .Clear
    .Enabled = False
    .BackColor = &HFFFFFF
    End With
End If
End Sub
Private Sub ComboBox3_Change()
If Not ComboBox3.Value = "" Then
    With Me.ComboBox4
        .Enabled = True
        .BackColor = &HFFFF&
        
        Dim ws As Worksheet
        Dim rcell As Range, Key
        Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
        Set ws = Worksheets("Sheet1")
            
        .Clear
        .Value = vbNullString
        
            For Each rcell In ws.Range("B2", ws.Cells(Rows.count, "B").End(xlUp))
                    If rcell.Offset(0, 0) <> ComboBox1.Value And rcell.Offset(0, -1) <> ComboBox2.Value And rcell.Offset(0, 5) <> ComboBox3.Value Then
                    Else
                        If Not dic.Exists(rcell.Offset(, 8).Value) Then
                            dic.Add rcell.Offset(, 8).Value, Nothing
                        End If
                    End If
            Next rcell
            For Each Key In dic
                Me.ComboBox4.AddItem Key
            Next
    End With
    Me.ComboBox5.Clear
Else
     With Me.ComboBox4
     .Clear
    .Enabled = False
    .BackColor = &HFFFFFF
    End With
    Me.ComboBox5.Clear
End If
End Sub

Private Sub ComboBox2_Change()
If Not ComboBox2.Value = "" Then
    With Me.ComboBox3
        .Enabled = True
        .BackColor = &HFFFF&
        
        Dim ws As Worksheet
        Dim rcell As Range, Key
        Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
        Set ws = Worksheets("Sheet1")
            
        .Clear
        .Value = vbNullString
        
            For Each rcell In ws.Range("B2", ws.Cells(Rows.count, "B").End(xlUp))
                    If rcell.Offset(0, 0) <> ComboBox1.Value And rcell.Offset(0, -1) <> ComboBox2.Value Then
                    
                    Else
                        If Not dic.Exists(rcell.Offset(, 5).Value) Then
                            dic.Add rcell.Offset(, 5).Value, Nothing
                        End If
                    End If
               ' Next rYear
            Next rcell
            For Each Key In dic
                Me.ComboBox3.AddItem Key
            Next
    End With
        Me.ComboBox4.Clear
        Me.ComboBox5.Clear
Else
     With Me.ComboBox3
     .Clear
    .Enabled = False
    .BackColor = &HFFFFFF
    End With
    Me.ComboBox4.Clear
    Me.ComboBox5.Clear
End If

End Sub
Private Sub ComboBox1_Change() 'done
If Not ComboBox1.Value = "" Then
    With Me.ComboBox2
        .Enabled = True
        .BackColor = &HFFFF&
        
        Dim ws As Worksheet
        Dim rcell As Range, Key
        Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
        Set ws = Worksheets("Sheet1")
            
        .Clear
        
            For Each rcell In ws.Range("B2", ws.Cells(Rows.count, "B").End(xlUp))
                    If rcell.Value = ComboBox1.Value Then
                        If Not dic.Exists(rcell.Offset(, -1).Value) Then
                            dic.Add rcell.Offset(, -1).Value, Nothing
                        End If
                    End If
            Next rcell
            For Each Key In dic
                Me.ComboBox2.AddItem Key
            Next
    End With
        Me.ComboBox3.Clear
        Me.ComboBox4.Clear
        Me.ComboBox5.Clear
Else
     With Me.ComboBox2
     .Clear
    .Enabled = False
    .BackColor = &HFFFFFF
    End With
    Me.ComboBox3.Clear
    Me.ComboBox4.Clear
    Me.ComboBox5.Clear

End If

End Sub

Private Sub UserForm_Initialize()
    
Dim ws As Worksheet
Dim rcell As Range
'dim dic as Object: set dic = createobject("Scripting.Dictionary")
Set ws = Worksheets("Sheet1")

ComboBox1.Clear

With CreateObject("scripting.dictionary")
For Each rcell In ws.Range("B2", ws.Cells(Rows.count, "B").End(xlUp))
If Not .Exists(rcell.Value) Then
.Add rcell.Value, Nothing
End If
Next rcell
ComboBox1.List = .Keys

End With
    With Me.ComboBox2
    .Enabled = False
    .BackColor = &HFFFFFF
    End With
    With Me.ComboBox3
    .Enabled = False
    .BackColor = &HFFFFFF
    End With
    With Me.ComboBox4
    .Enabled = False
    .BackColor = &HFFFFFF
    End With
    With Me.ComboBox5
    .Enabled = False
    .BackColor = &HFFFFFF
    End With
End Sub

What could go wrong in my ComboBoxes codes that it is not getting the correct list as expected during filter? And I don’t have a code yet to show filtered data in ListBox1. My desired output is to show filtered entries with complete columns (including the blank columns since I will be putting some data in these blanks for display purposes only along with the filtered entries) in ListBox1 during ComboBox5 change just like this one below except that it should be in ListBox1. Please help. Thank you in advance.

expected outcome

Solution

  • You need to fix the If clause for ComboBox2, ComboBox3 and ComboBox4 change event.

    • The If statement does not behave as expected. The If condition clause attempts to compare three values simultaneously. The condition will evaluate to False if any of these values mismatches. For instance, if rcell = ComboBox1.Value, then condition1 And condition2 And condition3 will be False, leading to the execution of the Else clause. It populates the next level combobox with extra items.
    ' If condition1 And condition2 And condition3 Then
If rcell.Offset(0, 0) <> ComboBox1.Value And rcell.Offset(0, -1) <> ComboBox2.Value And rcell.Offset(0, 5) <> ComboBox3.Value Then
Else
    If Not dic.Exists(rcell.Offset(, 8).Value) Then
        dic.Add rcell.Offset(, 8).Value, Nothing
    End If
End If
    • The return of ComboBox2.Value is string. rcell.Offset(0, -1) is a number. Conversion is needed in condition statement.

    The If statement should be as shown below. Both ComboBox3 and ComboBox4 event code should be updated. btw, Offset(0, 0) is not needed.

    Private Sub ComboBox3_Change()
    If Not ComboBox3.Value = "" Then
        With Me.ComboBox4
            ' your code
            For Each rcell In ws.Range("B2", ws.Cells(Rows.Count, "B").End(xlUp))
                If rcell = ComboBox1.Value And rcell.Offset(0, -1) = CStr(ComboBox2.Value) And rcell.Offset(0, 5) = ComboBox3.Value Then
                    If Not dic.Exists(rcell.Offset(, 8).Value) Then
                        dic.Add rcell.Offset(, 8).Value, Nothing
                    End If
                End If
            Next rcell
            For Each Key In dic
                Me.ComboBox4.AddItem Key
            Next
        End With
        ' your code 
End Sub

    Please check your previous post for how to populate listbox with an array if you have questions.

    How to show the last 10 entries in listbox made VBA

    Event code for combobox5.

    Private Sub ComboBox5_Change()
    If Not ComboBox5.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 _
                And arrData(i, 12) = ComboBox5.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
            .ColumnCount = UBound(arrData, 2)
            .List = arrList
        End With
    End If
End Sub