Populate other combo boxes based on previous combo boxes selection

[Pookiemeister]

Currently on a user form, I have 6 combo boxes. The first combo box gets its values from a spreadsheet. The first combo box pulls from the code below. What I am wanting to do is to have the other combo boxes remove any name that was already chosen from the previous combo box. Is this possible? Thank you.

See code below to see how its populated.

Private Sub UserForm_Initialize()
    ComboBox1.RowSource = "Employees!A2:A" & Range("A" & Rows.Count).End(xlUp).Row
End Sub

 

[Pookiemeister]

So this code relies on each combobox being clicked in order. Is there a way to modify this code to do the same thing regardless of what order the textboxes are clicked?

 

[dmt32]

So this code relies on each combobox being clicked in order. Is there a way to modify this code to do the same thing regardless of what order the textboxes are clicked?

cannot immediately think of a method

Dave

 

[Pookiemeister]

Private Sub ComboBox1_Change()
    PopulateComboBox Me.ComboBox1, Me.ComboBox2
    PopulateComboBox Me.ComboBox2, Me.ComboBox3
End Sub

I thought about modifying your code to see if it would work on three of the combo boxes but the error I am getting occurs on the second line of code. It occurs in the PopulateCombobox subroutine on this line of code.

... :arr(i) = Item

It never adds the last item into that combo box. It gives a "Run-Time error '9': Subscript out of range." I'm not what to modify in that subroutine to make this work. Thank you.

 

[Akuini]

@Pookiemeister

So this code relies on each combobox being clicked in order. Is there a way to modify this code to do the same thing regardless of what order the textboxes are clicked?

Try this:

Option Explicit
Dim d As Object
Dim e As Object
Dim va


Private Sub UserForm_Initialize()

Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare
Set e = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare

With Sheets("Employees")
    va = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
End With

End Sub

Private Sub ComboBox1_Enter()
    Call toPopulate(1)
End Sub

Private Sub ComboBox2_Enter()
    Call toPopulate(2)
End Sub

Private Sub ComboBox3_Enter()
    Call toPopulate(3)
End Sub

Private Sub ComboBox4_Enter()
    Call toPopulate(4)
End Sub

Private Sub ComboBox5_Enter()
    Call toPopulate(5)
End Sub

Private Sub ComboBox6_Enter()
    Call toPopulate(6)
End Sub

Private Sub toPopulate(n As Long)
Dim i As Long
Dim tx As String
Dim x

d.RemoveAll
e.RemoveAll
For i = 1 To 6
    tx = Me.Controls("Combobox" & i).Value
    If tx <> "" And i <> n Then e(tx) = Empty
Next

If e.Count <> 0 Then
    For Each x In va
        If Not e.Exists(x) Then d(x) = Empty
    Next
Else
    For Each x In va
        d(x) = Empty
    Next
End If

Me.Controls("Combobox" & n).List = d.keys


End Sub

 

[Pookiemeister]

Thank you @Akuini for you suggestion. However, when I click on the dropdown arrow, it doesn't do anything, it acts like there is nothing inside the combobox.

 

[Akuini]

It works for me. Try this example:

Pookiemeister

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.

www.mediafire.com

 

[Pookiemeister]

Does it matter in "Option Explicit" if "va" and "x" are not declared? Or are they defaulted to Variant? Thank you.

Option Explicit
Dim d As Object
Dim e As Object
Dim va

Private Sub toPopulate(n As Long)
Dim i As Long
Dim tx As String
Dim x

 

[Akuini]

Does it matter in "Option Explicit" if "va" and "x" are not declared? Or are they defaulted to Variant? Thank you.

It's variant by default.

 

[Pookiemeister]

Here is all the code for this project. I am hoping their is something in this code that is not allowing your code to work.

Option Explicit
Dim d As Object
Dim e As Object
Dim va


Private Sub btnCancel_Click()
    Unload Me
End Sub

Private Sub btnClear_Click()
    
    Call UserForm_Initialize
    
End Sub

Private Sub toPopulate(n As Long)
    
    Dim i As Long
    Dim tx As String
    Dim x
    
    d.RemoveAll
    e.RemoveAll
    For i = 1 To 6
        tx = Me.Controls("Combobox" & i).Value
        If tx <> "" And i <> n Then e(tx) = Empty
    Next
    
    If e.Count <> 0 Then
        For Each x In va
            If Not e.Exists(x) Then d(x) = Empty
        Next
    Else
        For Each x In va
            d(x) = Empty
        Next
    End If
    
    Me.Controls("Combobox" & n).List = d.keys

End Sub

Private Sub ComboBox1_Enter()
    Call toPopulate(1)
End Sub
Private Sub ComboBox2_Enter()
    Call toPopulate(2)
End Sub

Private Sub ComboBox3_Enter()
    Call toPopulate(3)
End Sub

Private Sub ComboBox4_Enter()
    Call toPopulate(4)
End Sub

Private Sub ComboBox5_Enter()
    Call toPopulate(5)
End Sub

Private Sub ComboBox6_Enter()
    Call toPopulate(6)
End Sub


Private Sub TextBox1_AfterUpdate()
    
    Dim tString As String
    With TextBox1
        'Check if user put in a colon or not
        If InStr(1, .Value, ":", vbTextCompare) = 0 Then
            'If not, make string 4 digits and insert colon
            tString = Format(.Value, "0000")
            tString = Left(tString, 2) & ":" & Right(tString, 2)
          
            TextBox1.Value = Format(TimeValue(tString), "HH:MM AM/PM")
        Else
            'Otherwise, take value as given
            .Value = Format(.Value, "hh:mm AM/PM")
        End If
    End With
    
End Sub

Private Sub TextBox2_AfterUpdate()
    
    Dim tString As String
    With TextBox2
        'Check if user put in a colon or not
        If InStr(1, .Value, ":", vbTextCompare) = 0 Then
            'If not, make string 4 digits and insert colon
            tString = Format(.Value, "0000")
            tString = Left(tString, 2) & ":" & Right(tString, 2)
          
            TextBox2.Value = Format(TimeValue(tString), "HH:MM AM/PM")
        Else
            'Otherwise, take value as given
            .Value = Format(.Value, "hh:mm AM/PM")
        End If
    End With
    
End Sub

Private Sub TextBox3_AfterUpdate()
    
    Dim tString As String
    
    With TextBox3
        'Check if user put in a colon or not
        If InStr(1, .Value, ":", vbTextCompare) = 0 Then
            'If not, make string 4 digits and insert colon
            tString = Format(.Value, "0000")
            tString = Left(tString, 2) & ":" & Right(tString, 2)
          
            TextBox3.Value = Format(TimeValue(tString), "HH:MM AM/PM")
        Else
            'Otherwise, take value as given
            .Value = Format(.Value, "hh:mm AM/PM")
        End If
    End With
    
End Sub

Private Sub TextBox4_AfterUpdate()
    
    Dim tString As String
    
    With TextBox4
        'Check if user put in a colon or not
        If InStr(1, .Value, ":", vbTextCompare) = 0 Then
            'If not, make string 4 digits and insert colon
            tString = Format(.Value, "0000")
            tString = Left(tString, 2) & ":" & Right(tString, 2)
          
            TextBox4.Value = Format(TimeValue(tString), "HH:MM AM/PM")
        Else
            'Otherwise, take value as given
            .Value = Format(.Value, "hh:mm AM/PM")
        End If
    End With
    
End Sub

Private Sub txtbxDate_AfterUpdate()
    
    Dim todaysDate As String
    
    todaysDate = Format(Me.txtbxDate.Value, "long date")

    If IsDate(Me.txtbxDate.Text) Then
         Me.txtbxDate.Text = todaysDate
    End If
    
End Sub

Private Sub txtbxDate_Enter()
    Me.txtbxDate.Value = ""
End Sub

Private Sub UserForm_Initialize()
        
'    Dim ctrl As Control
'
'    For Each ctrl In UserForm1.Controls
'        If TypeName(ctrl) = "TextBox" Then ctrl.Value = ""
'        If TypeName(ctrl) = "ComboBox" Then
'            ctrl.List = Sheets("Employees").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
'        End If
'    Next

    Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare
    Set e = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare
    
    With Sheets("Employees")
        va = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
    End With

End Sub

 

[Pookiemeister]

@Akuini I was just wondering, but in the following code:

Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare
Set e = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare

You have "Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare" but on the next line you have Set e = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare
Should the second line read: Set e = CreateObject("scripting.dictionary"): e.CompareMode = vbTextCompare


By changing d.CompareMode to e.CompareMode made no difference. Combobox1 still will not allow the dropdown choices to appear when the arrow is clicked.

Thank you.