Solved: Cascading dropdown list

[lcpx]

Hi all

In excel, is there a way I can create cascading dropdown list? I've been puzzled by this question for quite a long time. For example the first dropdown list contains all Fruits, and second one has sub-categories and product description as the last one. The dropdown list can be Combo Boxes or Validation List or in a Userform.

I've seen some examples on the web, but they don't work quite well as I expected.

Please find the product hierarchy file attached. Thanks very much for your time and help!

[austenr]

Try the following: This is an excerpt from Mr. Excel MB

Enter in some column what follows:

{"USA";"FRANCE"}[ That's, enter USA in a cell, then FRANCE in the next cell down ]

Select these cells, go to the Name Box on the Formula Bar, and type COUNTRIES followed by enter.

Enter in a column next to COUNTRIES:

{"New York";"Pittsburgh";"Los Angeles";"Boston"}

Name this range of cells USA via the Name Box as described above.

Enter in a column next to USA:

{"Paris";"Nice";"Toulon"}

Name this range FRANCE.

Just to see how this works,

activate A1 in some worksheet in the same workbook;

activate Data|Validation;

choose 'List' for 'Allow';

enter as 'Source' the formula:

=COUNTRIES

click OK;

activate another cell in the same worksheet, say, C1;

activate Data|Validation;

choose 'List' for 'Allow';

enter as 'Source' the formula:

=INDIRECT(A1)

click OK.

Now you have two lists of which the 2nd depends on the selection from the 1st.

[lcpx]

Hi austenr,
Thanks very much for your prompt response, I'm sure it would work. But it's not quite the way that I am expecting it to work.
As I've a very complicated hierarchical data and it can be updated once a week, the data is actually pulled from a dimension table in database. So I would prefer to make it work with VBA code.
Any idea would be greatly appreciated. Many thanks!

[Norie]

Could you give more information?

Austen's suggestion is one of many that can be used to create cascading comboboboxes.

There are many others and which to use can be dependent on your data structure and what you actually want to do.

[lcpx]

Hi Norie,
Thanks for your response.
Can you open the attachment I just uploaded? If you can't, I could zip it and upload again. That's my data structure.

I am developing reports for our users. They'd like to view the report by Product Category, subcategory or SKUS. So I need to provide several Prompts for them, once they select all filters, I'll pass these parameters to my SQL statement, and then display the query result.

I am sure the validation list would work, but in our case the hierarchy data might be updated once a week. So it's impossible we change the name range week by week. What I am think now is when users open the workbook, the hierarchic data would automatically pulled out from database to a hidden worksheet. Then cascading dropdown list will base on the data in that hidden worksheet.

Please let me know if i didn't make myself clear, Many thanks for your time and help!

[mdmackillop]

Here's a userform solution. Add three comboboxes to the userform.

Option Explicit

Private Sub UserForm_Initialize()
AddFruit Range([A2], [A2].End(xlDown))
ComboBox1.ListIndex = 0
End Sub

Sub AddFruit(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
On Error Resume Next
d.Add cel.Text, cel.Text
Next
ComboBox1.List() = d.items
End Sub

'********************************
Private Sub ComboBox1_Change()
ComboBox2.Clear
AddType Range([B2], [B2].End(xlDown))
End Sub

Sub AddType(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
If cel.Offset(, -1) = ComboBox1 Then
On Error Resume Next
d.Add cel.Text, cel.Text
End If
Next
ComboBox2.List() = d.items
End Sub

'********************************
Private Sub ComboBox2_Change()
ComboBox3.Clear
AddMake Range([C2], [C2].End(xlDown))
End Sub

Sub AddMake(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
If cel.Offset(, -1) = ComboBox2 Then
On Error Resume Next
d.Add cel.Text, cel.Text
End If
Next
ComboBox3.List() = d.items
End Sub

[lcpx]

Hi mdmackillop,

That VBA code works perfectly. Thanks very much.
Just one minor thing. When I changed the selection in the first drop down list, the second one changed accordingly apart from the top option item. The top one is the one I selected at the previous time which remain unchange.

For example: if I select Apple at the first drop down list, then select Pink Lady in the second one. It works perfectly so far.
But the next time when I select Banana, the top item in the second list wouldn't change, still as Pink Lady.

Please find the attachment for detail, Thanks very much for your time and help.

[mdmackillop]

I've edited my previous code to clear the comboboxes or for an alternative, the following should fill each combo with the first listed item of each category


Option Explicit

Private Sub UserForm_Initialize()
AddFruit Range([A1], [A1].End(xlDown))
ComboBox1.ListIndex = 0
End Sub

Sub AddFruit(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
On Error Resume Next
d.Add cel.Text, cel.Text
Next
ComboBox1.List() = d.items
End Sub

'********************************
Private Sub ComboBox1_Change()
ComboBox2.Clear
AddType Range([B1], [B1].End(xlDown))
ComboBox2.ListIndex = 0
ComboBox3.ListIndex = 0
End Sub

Sub AddType(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
If cel.Offset(, -1) = ComboBox1 Then
On Error Resume Next
d.Add cel.Text, cel.Text
End If
Next
ComboBox2.List() = d.items
End Sub

'********************************
Private Sub ComboBox2_Change()
ComboBox3.Clear
AddMake Range([C1], [C1].End(xlDown))
If ComboBox2 <> "" Then ComboBox3.ListIndex = 0
End Sub

Sub AddMake(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
If cel.Offset(, -1) = ComboBox2 Then
On Error Resume Next
d.Add cel.Text, cel.Text
End If
Next
ComboBox3.List() = d.items
End Sub

[lcpx]

That is really helpful, the problem has solved, thanks very much for your help and patience.

[malik641]

I am sure the validation list would work, but in our case the hierarchy data might be updated once a week. So it's impossible we change the name range week by week. I know this is solved, but I just want to state that you can have a dynamic named range that would update automatically when you add new data.

http://www.contextures.com/xlNames01.html

Just a FYI.



Really good stuff here, BTW.

[gsouza]

I can't seem to get it to work if i am on sheet 1 and my data is on sheet 2

Private Sub UserForm_Initialize()
AddFruit Worksheets("Sheet2").Range([A1], Worksheets("Sheet2").[A1].End(xlDown))
ComboBox1.ListIndex = 0
End Sub

Sub AddFruit(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
On Error Resume Next
Worksheets("Sheet2").d.Add cel.Text, cel.Text
Next
ComboBox1.List() = Worksheets("Sheet2").d.items
End Sub

'********************************
Private Sub ComboBox1_Change()
ComboBox2.Clear
AddType Worksheets("Sheet2").Range([B1], Worksheets("Sheet2").[B1].End(xlDown))
ComboBox2.ListIndex = 0
ListBox1.ListIndex = 0
End Sub

Sub AddType(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
If cel.Offset(, -1) = ComboBox1 Then
On Error Resume Next
Worksheets("Sheet2").d.Add cel.Text, cel.Text
End If
Next
ComboBox2.List() = Worksheets("Sheet2").d.items
End Sub

'********************************
Private Sub ComboBox2_Change()
ListBox1.Clear
AddMake Worksheets("Sheet2").Range([C1], Worksheets("Sheet2").[C1].End(xlDown))
If ComboBox2 <> "" Then ListBox1.ListIndex = 0
End Sub

Sub AddMake(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
If cel.Offset(, -1) = ComboBox2 Then
On Error Resume Next
Worksheets("Sheet2").d.Add cel.Text, cel.Text
End If
Next
ListBox1.List() = Worksheets("Sheet2").d.items
End Sub


can anybody tell me what I am doing wrong. I don't know what I am doing wrong. Thank you

[mdmackillop]

Hi,
The dictionary object "d" is not related to the worksheet. Try changing theses lines

Worksheets("Sheet2").d.Add cel.Text, cel.Text
Next
ComboBox1.List() = Worksheets("Sheet2").d.items

back to


d.Add cel.Text, cel.Text
Next
ComboBox1.List() = d.items


I'll check this out at home later.

Regards
MD

[mdmackillop]

Hi Gsouza,
Here's a general solution for 4 comboboxes, but it slows down considerably when run from another sheet.


Option Explicit

Const DataSheet = "Sheet1"
Dim Data1 As Range
Dim Data2 As Range
Dim Data3 As Range
Dim Data4 As Range

Private Sub UserForm_Initialize()
SetRanges
AddFruit Data1
ComboBox1.ListIndex = 0
End Sub


Sub SetRanges()
With Worksheets(DataSheet)
Set Data1 = .Range("A1:" & [A1].End(xlDown).Address)
Set Data2 = .Range("B1:" & [B1].End(xlDown).Address)
Set Data3 = .Range("C1:" & [C1].End(xlDown).Address)
Set Data4 = .Range("D1:" & [D1].End(xlDown).Address)
End With
End Sub
Sub AddFruit(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
On Error Resume Next
d.Add cel.Text, cel.Text
Next
ComboBox1.List() = d.items
End Sub

'********************************
Private Sub ComboBox1_Change()
ComboBox2.Clear
AddType Data2
ComboBox2.ListIndex = 0
ComboBox3.ListIndex = 0
ComboBox4.ListIndex = 0
End Sub

Sub AddType(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
If cel.Offset(, -1) = ComboBox1 Then
On Error Resume Next
d.Add cel.Text, cel.Text
End If
Next
ComboBox2.List() = d.items
End Sub

'********************************
Private Sub ComboBox2_Change()
ComboBox3.Clear
AddMake Data3
If ComboBox2 <> "" Then ComboBox3.ListIndex = 0
End Sub

Sub AddMake(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
If cel.Offset(, -1) = ComboBox2 Then
On Error Resume Next
d.Add cel.Text, cel.Text
End If
Next
ComboBox3.List() = d.items
End Sub
'********************************
Private Sub ComboBox3_Change()
ComboBox4.Clear
AddData Data4
If ComboBox3 <> "" Then ComboBox4.ListIndex = 0
End Sub

Sub AddData(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
If cel.Offset(, -1) = ComboBox3 Then
On Error Resume Next
d.Add cel.Text, cel.Text
End If
Next
ComboBox4.List() = d.items
End Sub

[gsouza]

Thanks alot, I am playing around with it, it is slow but it works. Thanks again for the quick reply

[mdmackillop]

Hi GSouza,
This seemed worthwhile playing about with, so here's a generic solution. It reads the values into an array, which speed things up considerably.

Option Explicit
Option Base 1

'Set values here
Const DataSheet = "Sheet1"
Const Cols = 4

Dim Data()
Dim r As Long, i As Long, j As Long
Dim d

Private Sub UserForm_Initialize()
Set d = CreateObject("Scripting.Dictionary")
AddDataToArray
comboOne
ComboBox1.ListIndex = 0
End Sub

Sub AddDataToArray()
With Worksheets(DataSheet)
r = .[A1].End(xlDown).Row
ReDim Data(r, Cols)
For i = 1 To 4
For j = 1 To r
Data(j, i) = .Cells(j, i)
Next j
Next i
End With
End Sub

Sub comboOne()
d.RemoveAll
For i = 1 To r
On Error Resume Next
d.Add Data(i, 1), Data(i, 1)
Next
ComboBox1.List() = d.items
End Sub

'********************************
Private Sub ComboBox1_Change()
ComboBox2.Clear
comboTwo
ComboBox2.ListIndex = 0
ComboBox3.ListIndex = 0
ComboBox4.ListIndex = 0
End Sub

Sub comboTwo()
d.RemoveAll
For i = 1 To r
If Data(i, 1) = ComboBox1 Then
On Error Resume Next
d.Add Data(i, 2), Data(i, 2)
End If
Next
ComboBox2.List() = d.items
End Sub

'********************************
Private Sub ComboBox2_Change()
ComboBox3.Clear
comboThree
If ComboBox2 <> "" Then ComboBox3.ListIndex = 0
End Sub

Sub comboThree()
d.RemoveAll
For i = 1 To r
If Data(i, 2) = ComboBox2 Then
On Error Resume Next
d.Add Data(i, 3), Data(i, 3)
End If
Next
ComboBox3.List() = d.items
End Sub

'********************************
Private Sub ComboBox3_Change()
ComboBox4.Clear
comboFour
If ComboBox3 <> "" Then ComboBox4.ListIndex = 0
End Sub

Sub comboFour()
d.RemoveAll
For i = 1 To r
If Data(i, 3) = ComboBox3 Then
On Error Resume Next
d.Add Data(i, 4), Data(i, 4)
End If
Next
ComboBox4.List() = d.items
End Sub

[gsouza]

Works great, this is really cool I think. It is an alternative to a tree control but cool in its own way. Hey thanks alot for your time. One simple thing that should be easy. How do I get a count of items in my combox4 list.

[mdmackillop]

How about adding a label to the form?
The caption line will need to be added to each "change" code


Private Sub UserForm_Initialize()
Set d = CreateObject("Scripting.Dictionary")
AddDataToArray
comboOne
ComboBox1.ListIndex = 0
Label1.Caption = ComboBox4.ListCount
End Sub

[jindon]

Hi,

I would go like this

1 ComboBox (ComboBox1)
1 Combobox or ListBox (ComboBox2 or ListBox1)
I personally prefer ListBox in this case...


Option Explicit
Private a()

Private Sub UserForm_Initialize()
Dim dic As Object, e As Variant
Set dic = CreateObject("scripting.dictionary")
dic.comparemode = vbTextCompare
With Sheets("RawData").Range("a1").CurrentRegion
a = .Offset(1).Resize(.Rows.Count - 1, 3).Value
End With
With Application
For Each e In .Index(a, 0, 1)
If Not IsEmpty(e) Then
If Not dic.exists(e) Then _
dic.Add e, Nothing
End If
Next
End With
Me.ComboBox1.List = dic.keys
Set dic = Nothing
End Sub

Private Sub ComboBox1_Change()
Dim b(), i, ii As Long, n As Long
For i = 1 To UBound(a, 1)
If a(i, 1) = Me.ComboBox1.Value Then
ReDim Preserve b(1, n)
For ii = 0 To 1
b(ii, n) = a(i, ii + 2)
Next
n = n + 1
End If
Next
With Me.ComboBox2 '<- if you choose ListBox then change to ListBox1
.ColumnCount = 2
.ColumnWidths = "100;100" ' <- alter to suite
.Column = b
End With
Erase b
End Sub

[mdmackillop]

Hi Jindon
Interesting to see other approaches. One question. The value of Combobox2 is the column B value. How do you show the Column C item in
eg Label1 = combobox2
Regards
MD

[jindon]

try

With Me.ComboBox2
Me.Label1=.List(.ListIndex,1)
End With

[gsouza]

This works great, and now I have a count. Thanks guys for all your help especially you
mdmackillop (http://www.vbaexpress.com/forum/member.php?u=87)
Thanks.

[mdmackillop]

Thanks Gsouza,
But Jindon has also added a new dimension :giggles: to the solution, which I much appreciate.
Regards
MD

[egood]

I have a couple of questions about the solution posted by mdmackillop.

/1/ Can we assume the speed up is from keeping the data in memory and reassigning it to the list each time rather than reading it from a range somewhere in the workbook?

/2/ If you wanted to do this in a similar way but with ActiveX components on your worksheet, what would be major areas for rework?

Some methods are not easily substituted [for example replacing ComboBox with ActiveSheet.OLEObjects("ComboBox1")] produces the following illegal statement.

ActiveSheet.OLEObjects("ComboBox1").List = d.items

I am using Excel 2007 on XP. Thx.