Search code examples
vbaexcelcomboboxuserform

Clear cascading ComboBox on reselection


I am in the process of creating a user form in excel that uses several ComboBox'. The first ComboBox lists values from column 1 of a table and the following ComboBox' lists values from the following columns. ComboBox 2 onwards also only lists values depending on the preceding box. All ComboBox' show unique values only.

Here is the current code I am using:

Option Explicit
Private Sub ComboBox1_Change()
    Call cValues(ComboBox1.Value, ComboBox2, 2)
End Sub
Private Sub ComboBox2_Change()
    Call cValues(ComboBox2.Value, ComboBox3, 3)
End Sub
Private Sub ComboBox3_Change()
    Call cValues(ComboBox3.Value, ComboBox4, 4)
End Sub
Private Sub ComboBox4_Change()
    Call cValues(ComboBox4.Value, ComboBox5, 5)
End Sub
Private Sub ComboBox5_Change()
    Call cValues(ComboBox5.Value, ComboBox6, 6)
End Sub

Private Sub UserForm_Initialize()
    Dim Rng         As Range
    Dim Dn          As Range
    Dim Dic         As Object
    With Sheets("Listuni")
        Set Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
    End With
    Set Dic = CreateObject("scripting.dictionary")
    Dic.CompareMode = vbTextCompare

    For Each Dn In Rng: Dic(Dn.Value) = Empty: Next
    Me.ComboBox1.List = Application.Transpose(Dic.keys)
End Sub

Sub cValues(txt As String, Obj As Object, col As Integer)
    Dim Dn              As Range
    Dim Rng             As Range
    Dim Dic             As Object
    With Sheets("Listuni")
        Set Rng = .Range(.Cells(2, col), .Cells(Rows.Count, col).End(xlUp))
    End With
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1

    For Each Dn In Rng
        If Dn.Offset(, -1).Value = txt Then
            If Not Dic.exists(Dn.Value) Then
                Dic(Dn.Value) = Empty
            End If
        End If
    Next Dn
    Obj.List = Application.Transpose(Dic.keys)
End Sub

The problem I am having occurs when a user makes a reselection of a preceding ComboBox. Instead of clearing the subsequent boxes, all existing selections remain.

I am looking for a way to clear/default the values of subsequent ComboBox every time a reselection of a preceding ComboBox is made. For example if I make a selection in ComboBox 1 and 2 but then change my selection at ComboBox 1, I want ComboBox 2 to clear rather than show my previous selection. Note that the default position for the user form on launch shows no values in any ComboBox.

I have tried using the .clear method on change however this always gets hung up at:

Obj.List = Application.Transpose(Dic.keys) 

I suspect this is because a clear is technically a change and therefore it cannot transpose the list of values to other boxes based on a null value.


Solution

  • This clears all subsequent ComboBoxes - if Combo1 changes, Combo2, 3, 4, 5, and 6 are cleared

    Option Explicit
    
    Private ws  As Worksheet
    Private d   As Object
    
    Private Sub UserForm_Initialize()
        Dim cel As Range, txt As String, rng As Range
    
        Set ws = Worksheets("Listuni")
        Set d = CreateObject("Scripting.Dictionary"): d.CompareMode = vbTextCompare
    
        Set rng = ws.Range(ws.Cells(2, 1), ws.Cells(ws.Rows.Count, 1).End(xlUp))
    
        For Each cel In rng: d(cel.Value) = Empty: Next
        ComboBox1.List = Application.Transpose(d.keys)
    End Sub
    
    Private Function setList(ByVal txt As String, ByRef cmb As ComboBox) As Object
        Dim xID As Long, rng As Range, cel As Range, x As Control
    
        xID = Right(cmb.Name, 1)
        For Each x In Me.Controls
            If TypeName(x) = "ComboBox" Then If Val(Right(x.Name, 1)) > xID - 1 Then x.Clear
        Next
    
        Set rng = ws.Range(ws.Cells(2, xID), ws.Cells(ws.Rows.Count, xID).End(xlUp))
    
        d.RemoveAll
        For Each cel In rng
            If cel.Offset(, -1) = txt Then
                If Not d.exists(cel.Value) Then
                    d(cel.Value) = Empty
                End If
            End If
        Next
        If d.Count > 0 Then cmb.List = Application.Transpose(d.keys) Else cmb.Clear
    End Function
    
    Private Sub ComboBox1_Change()
        setList ComboBox1.Value, ComboBox2
    End Sub
    Private Sub ComboBox2_Change()
        setList ComboBox2.Value, ComboBox3
    End Sub
    Private Sub ComboBox3_Change()
        setList ComboBox3.Value, ComboBox4
    End Sub
    Private Sub ComboBox4_Change()
        setList ComboBox4.Value, ComboBox5
    End Sub
    Private Sub ComboBox5_Change()
        setList ComboBox5.Value, ComboBox6
    End Sub
    

    cascade