CODEWITHSUNDEEP
excelvba
Zainedevontay
Zainedevontay

Reputation: 17

Two Dependent Combo Boxes


**Edit:** Managed to find the solution to it thanks to fellow user @Tin Bum
I'm trying to make 2 Combo Box where the the first one (Cmb1) will show only unique values from Column 1 and then (Cmb2) will show a list of values from Column 2 that are related to Column 1.
Populating the Cmb1 has been successful however the problem lies with populating Cmb2. 

Column 1    Column 2
1             a
1             b
1             c
2             d
2             e

The problem lies with populating Cmb2

Private Sub UserForm_Activate()
Dim wslk As Worksheet
Set wslk = Worksheets("w1")
With wslk
t1 = .Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).row

On Error Resume Next
For y = 2 To t1
Set c = .Cells(y, 2)
Set t1rng = .Range(.Cells(2, 2), .Cells(y, 2))
x = Application.WorksheetFunction.CountIf(t1rng, c)
If x = 1 Then Cmb1.AddItem c
Next y
On Error GoTo 0
End With

End Sub

Private Sub Cmb1_Change()
Dim wslk As Worksheet
Set wslk = Worksheets("w1")

Private Sub Cmb1_Change()
Dim wslk As Worksheet
Set wslk = Worksheets("w1")

Cmb2.ListIndex = -1
If Cmb1.ListIndex > -1 Then
'Currently I am stuck over here
Cmb2.List =

**Solution:**
Dim i As Integer
    Cmb2.Clear

For i = 2 To wslk.Range("B" & Application.Rows.Count).End(xlUp).row
    If wslk.Range("B" & i).Value = Cmb1.Value Then
    Cmb2.AddItem wslk.Range("C" & i)
End If

End If
End Sub

Upvotes: 0

Views: 75

Answers (3)

Zainedevontay
Zainedevontay

Reputation: 17

Private Sub Cmb1_Change()
Dim wslk As Worksheet
Set wslk = Worksheets("w1")

Dim i As Integer
    Cmb2.Clear

For i = 2 To wslk.Range("B" & Application.Rows.Count).End(xlUp).row
    If wslk.Range("B" & i).Value = Cmb1.Value Then
    Cmb2.AddItem wslk.Range("C" & i)
End If

Upvotes: 0

Tin Bum
Tin Bum

Reputation: 1491

This the bones of a solution for the Exit Event Code. It should be Ok for hundreds of rows but may be slow for thousands of rows, also you still have to workout the 2 ranges - I've arbitrarily assigned them to fixed ranges.

On the plus side it should be simple to follow

Dim Rng1 As Range, Rng2 As Range
Dim xCel As Range, List2 As String

Rng1 = Range("A10:A20") ' whatever Range covers your Col1 Data
Rng2 = Range("B10:B20") ' whatever Range covers your Col2 Data

List2 = ""
For Each xCel In Rng2.Cells
   If xCel.Offset(0, -1).Value = Combobox1.Value Then
      ' Add this Value to a String using VbCrLf as a Separator
      List2 = IIf(List2 = "", "", List2 & vbCrLf) & CStr(xCel.Value)
   End If
Next xCel
' Split the String into an Array of Values for ComboBox2
ComboBox2.List = Split(List2, vbCrLf)

It also relies on NOT HAVING CHR(13) & CHR(10) (VbCrLF) in your data

Upvotes: 1

Tom
Tom

Reputation: 9878

You could use a Dictionary to get your unique values and also populate this on your Initialize Sub. Making this a Public variable in the scope of the Userform will allow you to then use it later on the Change event as well to get your list values

Option Explicit
Private Uniques As Object
Private Sub UserForm_Initialize()
    Dim c As Range, InputRng As Range
    Dim tmp As Variant
    Dim k As String

    Set Uniques = CreateObject("Scripting.Dictionary")
    With Worksheets("w1")
        Set InputRng = .Range(.Cells(2, 2), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 2))

        For Each c In InputRng
            k = c.Value2
            If Uniques.exists(k) Then
                tmp = Uniques(k)
                ReDim Preserve tmp(LBound(tmp) To UBound(tmp) + 1)
                tmp(UBound(tmp)) = c.Offset(0, 1).Value2
                Uniques(k) = tmp
            Else
                ReDim tmp(0)
                tmp(0) = c.Offset(0, 1).Value2
                Uniques.Add Key:=k, Item:=tmp
            End If
        Next c

        Cmb1.List = Uniques.keys
    End With

End Sub
Private Sub Cmb1_Change()
    Cmb2.ListIndex = -1
    If Cmb1.ListIndex > -1 Then
        Cmb2.List = Uniques(Cmb1.Value)
    End If
End Sub

Upvotes: 0

Related Questions