2 droplist

davidson

New Member
Joined
Oct 19, 2006
Messages
32
I would like to create 2 droplist in the excel. The value of the droplist would be obtained from a table. The table would be in the following format:

A 2
B 7
A 12
C 8
A 9
B 15
B 17

So for the first droplist, I would like to have the values A, B, C for the user to select (without duplicate). The value of second droplist would then depend on what is chosen by the user in first droplist. For example, if the user chooses A in the 1st droplist, I would like to have 2,12, 9 in the 2ns droplist for the user to select. It is possible or difficult to do this?

Thanks
 
I don't think you need 3
try this
Code:
Private dic As Object

Private Sub Worksheet_Activate
Dim r As Range, w(), z As String
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
With Sheets("Sheet1") '<- change "sheet1" to suite
   For Each r In .Range("a1",.Range("a" & Rows.Count).End(xlUp))
      If Not IsEmpty(r) Then
         z = r.Value & " ; " & r.Offset(,1).Value
         If Not dic.exists(z) Then
            ReDim w(0) : w(0) = r.Offset(,2).Value
            dic.add z, w
         Else
            w = dic(z)
            ReDim Preserve w(UBound(w) + 1)
            w(UBound(w)) = r.Offset(,2).Value
            dic(z) = w
         End If
      End If
   Next
End With
Me.ComboBox1.List = dic.keys
End Sub

Private Sub ComboBox1_Change()
With Me
   If .ComboBox1.ListIndex > -1 Then
      .ComboBox2.List = dic(.ComboBox1.Value)
   End If
End With
End Sub
 
Upvote 0

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Hi Jindon,

I need to have 3 comboBox for my application, because there are 3 different types of things for the user to input. WHat I like to have is that the application would restrict the value of the comboBox based on the values of other two comboBox. There would be a table helping us to match.

my table is like this:

A 2 TT
B 16 UU
C 3 KL
A 2 YG
A 1 CB
A 4 FG

SO if the user choose A in comboBox1 and 2 in combobox, the only values available for the user in combobox3 is "TT" amd "YG".

Can I do that with the code supplied by you below?

Thanks a lot, Jindon

I don't think you need 3
try this
Code:
Private dic As Object

Private Sub Worksheet_Activate
Dim r As Range, w(), z As String
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
With Sheets("Sheet1") '<- change "sheet1" to suite
   For Each r In .Range("a1",.Range("a" & Rows.Count).End(xlUp))
      If Not IsEmpty(r) Then
         z = r.Value & " ; " & r.Offset(,1).Value
         If Not dic.exists(z) Then
            ReDim w(0) : w(0) = r.Offset(,2).Value
            dic.add z, w
         Else
            w = dic(z)
            ReDim Preserve w(UBound(w) + 1)
            w(UBound(w)) = r.Offset(,2).Value
            dic(z) = w
         End If
      End If
   Next
End With
Me.ComboBox1.List = dic.keys
End Sub

Private Sub ComboBox1_Change()
With Me
   If .ComboBox1.ListIndex > -1 Then
      .ComboBox2.List = dic(.ComboBox1.Value)
   End If
End With
End Sub
 
Upvote 0
try
Code:
Private a() As Variant, dic As Object

Private Sub Worksheet_Activate()
Dim i As Long
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
a = Sheets("Sheet1").Range("a1").CurrentRegion.Resize(,3).Value
For i = 1 To UBound(a,1)
    If Not IsEmpty(a(i,1)) And Not dic.exists(a(i,1)) Then dic.add a(i,1), Nothing
Next
Me.ComboBox1.List = dic.keys
End Sub

Private Sub ComboBox1_Change()
Dim i As Long
With Me
    .ComboBox3.Clear
    If .ComboBox1.ListIndex = -1 Then
        .ComboBox2.Clear
        ExitSub
    End If
    dic.removeall
    For i = 1 To UBound(a,1)
        If a(i,1) = .ComboBox1.Value And Not dic.exists(a(i,2)) Then
            dic.add a(i,2), Nothing
        End If
    Next
    If dic.count > 0 Then .ComboBox2.List = dic.keys
End With
End Sub

Private Sub ComboBox2_Change()
Dim i As Long, cb1, cb2
With Me
    If .ComboBox1.ListIndex = -1 Or .ComboBox2.ListIndex = -1 Then
        .ComboBox3.Clear
        Exit Sub
    End If
    cb1 = .ComboBox1.Value
    cb2 = .ComboBox2.Value
    .ComboBox3.Clear
    For i = 1 To UBound(a,1)
        If a(i,1) = cb1 And a(i,2) = cb2 Then
            .ComboBox3.AddItem a(i,3)
        End If
    Next
End With
End Sub
 
Upvote 0
Hi,

I have a similar problem that is partially solved by this. I have a table with 40 names that each have a department and division.

My problem is that I need to be able to select the 40 names individually one after the other from combo boxes on each of the 40 rows of the table. The user will select a department from a combo box and depending on the department selected, the relevant names and divisions for that department will be displayed in combo boxes on the same row of the table.

Any ideas? Perhaps I'm missing something simple :confused:
 
Upvote 0
Jindon, would you mind if I send you an email about part of my project on that problem. It is difficult to explain without referring to the code and spreadsheet. My email address is chengkithung@hotmail.com. Thanks a lot, Jindon.
 
Upvote 0
Hi Jindon,

My project is more complicated than previously explained.

There are 2 tables, 1 table in sheet1 and another in Sheet2.

In Sheet3, I have several comboBox.

The format of table in sheet1 is:

A 2
B 3
A 6
B 7
C 89

And in the comboBox1 in Sheet3, the availble value is in the first column of sheet1 table (i.e. A, B, C) and the value of ComboBox2 would depend on the value of comboBox1. This is what we have done so far by using your code.

NOW ComboBox3 has the value of "Yes" and "No". If the user chooses "No", nothing would happen. But if the user chooses "Yes", then we need to go to table in Sheet2 this time, not Sheet1 table.


Sheet2 table is of the following format:

A 7 HHH
B 7 MM
B 7 KL
N 7 J
C 10 KK

SO if the user choose "Yes" in comboBox3, then we need to match the chosen value of ComboBox1 and ComboBox2 and the coumn1 and column2 of sheet2 table and the value of ComboBox would be found out.

For example, if the comboBox1 is B, comboBox2 is 7, comboBox3 is "yes", then the avialble value of comboBox4 should be "MM" and "KL".

Can you help the latter part? Helps
 
Upvote 0
try
Code:
Private dic As Object

Private Sub Worksheet_Activate
Dim r As Range, w()
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
With Sheets("Sheet1")
    For Each r In Range("a1",Range("a" & Rows.Count).End(xlUp))
        If Not IsEmpty(r) Then
            If Not dic.exists(r.Value) Then
                ReDim w(0) : w(0) = r.Offset(,1).Value
                dic.add r.Value, w
            Else
                w = dic(r.Value)
                ReDim Preserve w(UBound(w) + 1)
                w(UBound(w)) = r.Offset(,1).Value
                dic(r.Value) = w
            End If
        End If
    Next
End With
Me.ComboBox1.List = dic.keys
End Sub

Private Sub ComboBox1_Change()
Me.ComboBox2.Clear
Me.ComboBox3.Clear
Me.ComboBox4.Clear
With Me
   If .ComboBox1.ListIndex > -1 Then
      .ComboBox2.List = dic(.ComboBox1.Value)
   End If
End With
End Sub

Private Sub ComboBox2_Change()
Me.ComboBox3.Clear
Me.ComboBox4.Clear
With Me
    If .ComboBox1.ListIndex > -1 And .ComboBox2.ListIndex > -1 Then
        .ComboBox3.List = Array("Yes","No")
    End If
    .ComboBox3.ListIndex = -1
End With
End Sub

Private Sub ComboBox3_Change()
Dim a, x, y, i As Long, b()
Me.ComboBox4.Clear
If Me.ComboBox3.ListIndex = 1 Then Exit Sub
If (Me.ComboBox1.ListIndex > -1) * (Me.ComboBox2.ListIndex > -1) Then
    x = Me.ComboBox1.Value : y = Me.ComboBox2.Value
    With Sheets("Sheet2")
        a = .Range("a1").CurrentRegion.Resize(,3).Value
        For i = 1 To UBound(a,1)
            If (a(i,1) = x) * (a(i,2) = y) Then
                n = n + 1
                ReDim Preserve b(1 To n)
                b(n) = a(i,3)
            End If
        Next
    End With
End If
If n > 0 Then Me.ComboBox4.List = b
End Sub
 
Upvote 0
Hi, Jinodn,

I have tried your code. But the value of comboBox4 cannot be displayed (i.e. the list of that combobox is empty) even when it should not be. Can you help?

Thanks a lot.

try
Code:
Private dic As Object

Private Sub Worksheet_Activate
Dim r As Range, w()
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
With Sheets("Sheet1")
    For Each r In Range("a1",Range("a" & Rows.Count).End(xlUp))
        If Not IsEmpty(r) Then
            If Not dic.exists(r.Value) Then
                ReDim w(0) : w(0) = r.Offset(,1).Value
                dic.add r.Value, w
            Else
                w = dic(r.Value)
                ReDim Preserve w(UBound(w) + 1)
                w(UBound(w)) = r.Offset(,1).Value
                dic(r.Value) = w
            End If
        End If
    Next
End With
Me.ComboBox1.List = dic.keys
End Sub

Private Sub ComboBox1_Change()
Me.ComboBox2.Clear
Me.ComboBox3.Clear
Me.ComboBox4.Clear
With Me
   If .ComboBox1.ListIndex > -1 Then
      .ComboBox2.List = dic(.ComboBox1.Value)
   End If
End With
End Sub

Private Sub ComboBox2_Change()
Me.ComboBox3.Clear
Me.ComboBox4.Clear
With Me
    If .ComboBox1.ListIndex > -1 And .ComboBox2.ListIndex > -1 Then
        .ComboBox3.List = Array("Yes","No")
    End If
    .ComboBox3.ListIndex = -1
End With
End Sub

Private Sub ComboBox3_Change()
Dim a, x, y, i As Long, b()
Me.ComboBox4.Clear
If Me.ComboBox3.ListIndex = 1 Then Exit Sub
If (Me.ComboBox1.ListIndex > -1) * (Me.ComboBox2.ListIndex > -1) Then
    x = Me.ComboBox1.Value : y = Me.ComboBox2.Value
    With Sheets("Sheet2")
        a = .Range("a1").CurrentRegion.Resize(,3).Value
        For i = 1 To UBound(a,1)
            If (a(i,1) = x) * (a(i,2) = y) Then
                n = n + 1
                ReDim Preserve b(1 To n)
                b(n) = a(i,3)
            End If
        Next
    End With
End If
If n > 0 Then Me.ComboBox4.List = b
End Sub
 
Upvote 0
How about
Code:
Private dic As Object

Private Sub Worksheet_Activate
Dim r As Range, w()
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
With Sheets("Sheet1")
    For Each r In Range("a1",Range("a" & Rows.Count).End(xlUp))
        If Not IsEmpty(r) Then
            If Not dic.exists(r.Value) Then
                ReDim w(0) : w(0) = r.Offset(,1).Value
                dic.add r.Value, w
            Else
                w = dic(r.Value)
                ReDim Preserve w(UBound(w) + 1)
                w(UBound(w)) = r.Offset(,1).Value
                dic(r.Value) = w
            End If
        End If
    Next
End With
Me.ComboBox1.List = dic.keys
End Sub

Private Sub ComboBox1_Change()
Me.ComboBox2.Clear
Me.ComboBox3.Clear
Me.ComboBox4.Clear
With Me
   If .ComboBox1.ListIndex > -1 Then
      .ComboBox2.List = dic(.ComboBox1.Value)
   End If
End With
End Sub

Private Sub ComboBox2_Change()
Me.ComboBox3.Clear
Me.ComboBox4.Clear
With Me
    If .ComboBox1.ListIndex > -1 And .ComboBox2.ListIndex > -1 Then
        .ComboBox3.List = Array("Yes","No")
    End If
    .ComboBox3.ListIndex = -1
End With
End Sub

Private Sub ComboBox3_Change()
Dim a, x, y, i As Long, b(), n As Long
Me.ComboBox4.Clear
If Me.ComboBox3.Value <> "Yes" Then
    Me.Combobox4.Clear
    Exit Sub
End If
If Me.ComboBox1.ListIndex > -1 And Me.ComboBox2.ListIndex > -1 Then
    x = Me.ComboBox1.Value : y = Me.ComboBox2.Value
    a = Sheets("Sheet2").Range("a1").CurrentRegion.Resize(,3).Value
    For i = 1 To UBound(a,1)
         If a(i,1) = x And a(i,2) = y Then
            n = n + 1
            ReDim Preserve b(1 To n)
            b(n) = a(i,3)
        End If
    Next
End If
If n > 0 Then Me.ComboBox4.List = b
End Sub
 
Upvote 0

Forum statistics

Threads
1,215,869
Messages
6,127,415
Members
449,382
Latest member
DonnaRisso

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top