How Shall I approach this

[mahmed1]

Hi Guys,

Im hoping you can guide me to do this in a more structured way making it more simple and robust

I have a lookup sheet that holds

Area Name
Department Names
Team Name

Each team will have a Department name which feeds into the Area name

Now i want to create a dependent lookup combo box So depending on which area name i pick, the department dropdown should pick up the departments only for that area and then the team names should pickup the relevant teams based on the department picked

Now i know i can used named ranges and use the indirect function to get the correct list however I have

5 Area names
10 departments
Each Department holds 7-10 teams each so i will be creating loads of named ranges..

Is there a better way to do this even using VBA? My combo boxes are Active X objects

 

[FDibbins]

To make this kind of dependent DD, you will definitely need a bunch of range names.

If you already know how to do it this way, great, if not, let me know and I will try and walk you through

 

[mahmed1]

Thank you buddy - The only way i can think of doing it is for each area create a department and for each department name it for each team

I know how to use the indirect on dropdown list but not on active x controls (combobox)

I dont know if VBA is the best approach to take - if that is something you can help me with that would be awesome

I have tried to write some code and the best i have got is populating the unique area names - I now need a way to populate the 2nd combobox with the relevant departments based on the area selection

This is what ive got so far

Private Sub ComboBox1_Change()
    Application.EnableEvents = False
        Me.Range("J1").Value = Me.ComboBox1.Value
        If Me.Range("J1").Value = "ALL" Then
           Me.Range("J2").Value = "ALL"
           Me.Range("J3").Value = "ALL"
        Else
           Me.Range("J2").Value = ""
           Me.Range("J3").Value = ""
        End If
    Application.EnableEvents = True
End Sub


Private Sub Worksheet_Activate()


Dim Dict As Object
Dim AreaRangeList As Variant
Dim AreaName As Variant
Dim DeptRangeList As Variant
Dim DeptName As Variant
Dim TeamRangeList As Variant
Dim TeamName As Variant


AreaRangeList = Me.Range("A2:A14").Value
' DeptRangeList = Me.Range("B2:B100").Value
' TeamRangeList = Me.Range("C2:C100").Value


Set Dict = CreateObject("scripting.dictionary")


With Dict
    .comparemode = 1
    For Each AreaName In AreaRangeList
        If Not .exists(AreaName) Then .Add AreaName, Nothing
    Next
        
    Me.ComboBox1.List = Application.Transpose(.keys)
    Me.ComboBox1.AddItem "ALL"
        
    With Me
        .ComboBox1.ListIndex = 0
        .Range("J1").Value = .ComboBox1.Value
    End With
End With


End Sub

 

[FDibbins]

VBA is not my strong side I would do this with range names - it may take a little effort to set it all up, but once done, should be easy to maintain and update

	B​	C​	D​
3​	Type​	Category​	Breed​
4​	Fish	Marine	Shark
5​
6​
7​	1. create a range name for the main category
8​	2. create a range name for each sub-category, based on what it is
9​
10​	for mine, the main category is called Type (A2)
11​	for the sub categories I give them the same name as in Type (B2:E2)
12​	(if you have another level, you would repeat this for eacg subcategory, to get sub-sub-categries)
13​
14​	To get the DD's to work...
15​
16​	DD for B4 =TYPE
17​	DD for C4 =INDIRECT(SUBSTITUTE(B4," ","_"))

My data range, with range names at the top...

	A​	B​	C​	D​	E​	F​	G​	H​	I​	J​
2​	Type	Mammal	Bird	Fish	Bug		Dog	Cat	Fresh Water	Marine
3​	Mammal	Dog	Domestic	Fresh Water	Insect		Doberman	Lion	Trout	Shark
4​	Bird	Cat	Wild	Marine	Arachnid		Poodle	Tiger	Minow	Barracuda
5​	Fish	Cow					bulldog	House	Pike
6​	Bugs

 

[mahmed1]

Thank you - This works great but it would be wonderful if i could do this with an active x control as with a drop down box - the drop down arrow disappears if your not on that cell and also with the active x controls - i can clear the combo boxes when i change the selection

hopefully you or someone else can help me with this VBA approach if it cant be done another way

 

[mahmed1]

Can anyone be kind enough to replicate FDinbins approach via VBAusing active x combo boxes? Would really be greatful for this

 

[lrobbo314]

You can see below how I set up the table for Team, Department, and Area. I then added 3 activeX drop downs. I named them areaDD, departmentDD, and teamDD.

The following code seems to do what you are looking for on my sample data below.

Public Dict As Object
Public r As Range
Public cel As Range
Private Sub AreaDD_Change()
Me.DepartmentDD.Value = vbNullString
Me.TeamDD.Value = vbNullString
End Sub
Private Sub DepartmentDD_GotFocus()
If Len(Me.AreaDD.Value) > 0 Then
    Set Dict = CreateObject("scripting.dictionary")
    Set r = Range("B2", Range("B" & Rows.Count).End(xlUp))
    
    With Dict
        For Each cel In r
            If Not .exists(cel.Value) And cel.Offset(, 1).Value = Me.AreaDD.Value Then .Add cel.Value, Nothing
        Next cel
        Me.DepartmentDD.List = Application.Transpose(.keys)
    End With
End If
End Sub
Private Sub TeamDD_GotFocus()
If Len(Me.DepartmentDD.Value) > 0 And Len(Me.AreaDD) > 0 Then
    Set Dict = CreateObject("scripting.dictionary")
    Set r = Range("A2", Range("A" & Rows.Count).End(xlUp))
    
    With Dict
        For Each cel In r
            If Not .exists(cel.Value) And cel.Offset(, 1).Value = Me.DepartmentDD.Value And cel.Offset(, 2).Value = Me.AreaDD.Value Then .Add cel.Value, Nothing
        Next cel
        Me.TeamDD.List = Application.Transpose(.keys)
    End With
End If
End Sub
Private Sub Worksheet_Activate()
Set Dict = CreateObject("scripting.dictionary")
Set r = Range("C2", Range("C" & Rows.Count).End(xlUp))
With Dict
    For Each cel In r
        If Not .exists(cel.Value) Then .Add cel.Value, Nothing
    Next cel
    Me.AreaDD.List = Application.Transpose(.keys)
End With
End Sub

<!--The following information was generated by Microsoft Excel's Publish as WebPage wizard.--><!--If the same item is republished from Excel, all information between the DIVtags will be replaced.--><!-----------------------------><!--START OF OUTPUT FROM EXCEL PUBLISH AS WEB PAGE WIZARD --><!----------------------------->

	A	B	C
1	Team Name	Department	Area
2	Team 1	Department 1	Area 1
3	Team 2	Department 2	Area 2
4	Team 3	Department 3	Area 3
5	Team 4	Department 4	Area 4
6	Team 5	Department 5	Area 5
7	Team 6	Department 6	Area 1
8	Team 7	Department 7	Area 2
9	Team 8	Department 8	Area 3
10	Team 9	Department 9	Area 4
11	Team 10	Department 10	Area 5
12	Team 11	Department 1	Area 1
13	Team 12	Department 2	Area 2
14	Team 13	Department 3	Area 3
15	Team 14	Department 4	Area 4
16	Team 15	Department 5	Area 5
17	Team 16	Department 6	Area 1
18	Team 17	Department 7	Area 2
19	Team 18	Department 8	Area 3
20	Team 19	Department 9	Area 4
21	Team 20	Department 10	Area 5
22	Team 21	Department 1	Area 1
23	Team 22	Department 2	Area 2
24	Team 23	Department 3	Area 3
25	Team 24	Department 4	Area 4
26	Team 25	Department 5	Area 5
27	Team 26	Department 6	Area 1
28	Team 27	Department 7	Area 2
29	Team 28	Department 8	Area 3
30	Team 29	Department 9	Area 4
31	Team 30	Department 10	Area 5

<tbody>
</tbody>

<!-----------------------------><!--END OF OUTPUT FROM EXCEL PUBLISH AS WEB PAGE WIZARD--><!-----------------------------> <!--The following information was generated by Microsoft Excel's Publish as WebPage wizard.--><!--If the same item is republished from Excel, all information between the DIVtags will be replaced.--><!-----------------------------><!--START OF OUTPUT FROM EXCEL PUBLISH AS WEB PAGE WIZARD --><!----------------------------->

​

<!-----------------------------><!--END OF OUTPUT FROM EXCEL PUBLISH AS WEB PAGE WIZARD--><!----------------------------->