Excel 2007 Combo Boxes and Filtering a Data Set

Not sure this is even possible but....
I would like to have a series of 4 combo boxes "link" to each other (Not sure if link is the correct term here) in a way that mimics filtering a data set in an Excel spreadsheet.

After the user chooses a value in combo-box 1 (column A)
I would like to "filter" the options in combo-box  2 (column B) to only values in (column B) that correspond with values in the (column A) = selection in combo-box 1.

This "Filtering" of data that populate each combo box would flow down through to the third and fourth combo boxes.

Do I need to make lists of all the possible filtering combinations or can the filtering be done dynamically?

The attached form has an example of the 4 combo boxes and data I'm working with.

For my example combo boxes I used data validation cells.  Maybe I need to use an Active X or Form comb box - not sure about the differences here.

Thank you!
FILTER-DROP-DOWN-TEST.xlsx
dec789Asked:
Who is Participating?
 
krishnakrkcCommented:
Hi

In a standard module

Option Explicit
Public dicSector    As Object
Public dicUnit      As Object
Public dicDept      As Object
Sub GET_ALL_DATA()
        
    Dim dicSec  As Object
    Dim dicUni  As Object
    Dim dicDep  As Object
    
    If dicSector Is Nothing Then
        Set dicSector = CreateObject("scripting.dictionary")
            dicSector.comparemode = 1
        Set dicUnit = CreateObject("scripting.dictionary")
            dicUnit.comparemode = 1
        Set dicDept = CreateObject("scripting.dictionary")
            dicDept.comparemode = 1
    End If
    
    Set dicSec = CreateObject("scripting.dictionary")
        dicSec.comparemode = 1
    Set dicUni = CreateObject("scripting.dictionary")
        dicUni.comparemode = 1
    Set dicDep = CreateObject("scripting.dictionary")
        dicDep.comparemode = 1
        
    Dim Data, i As Long
    Dim strItems    As String
    Dim strConcat   As String
    
    Data = Worksheets("Data").Range("a1").CurrentRegion.Resize(, 4).Value2
    
    For i = 2 To UBound(Data, 1)
        If Len(Data(i, 1)) * Len(Data(i, 2)) Then
            strItems = dicSector.Item(Data(i, 1))
            If Len(strItems) Then
                If Not dicSec.exists(Data(i, 2)) Then
                    dicSector.Item(Data(i, 1)) = strItems & "," & Data(i, 2)
                    dicSec.Add Data(i, 2), Nothing
                End If
            Else
                dicSector.Item(Data(i, 1)) = Data(i, 2)
                dicSec.Add Data(i, 2), Nothing
            End If
        End If
        If Len(Data(i, 1)) * Len(Data(i, 2)) * Len(Data(i, 3)) Then
            strConcat = Data(i, 1) & "|" & Data(i, 2)
            strItems = dicUnit.Item(strConcat)
            If Len(strItems) Then
                If Not dicUni.exists(Data(i, 3)) Then
                    dicUnit.Item(strConcat) = strItems & "," & Data(i, 3)
                    dicUni.Add Data(i, 3), Nothing
                End If
            Else
                dicUnit.Item(strConcat) = Data(i, 3)
                dicUni.Add Data(i, 3), Nothing
            End If
        End If
        If Len(Data(i, 1)) * Len(Data(i, 2)) * Len(Data(i, 3)) * Len(Data(i, 4)) Then
            strConcat = Data(i, 1) & "|" & Data(i, 2) & "|" & Data(i, 3)
            strItems = dicDept.Item(strConcat)
            If Len(strItems) Then
                If Not dicDep.exists(Data(i, 4)) Then
                    dicDept.Item(strConcat) = strItems & "," & Data(i, 4)
                    dicDep.Add Data(i, 4), Nothing
                End If
            Else
                dicDept.Item(strConcat) = Data(i, 4)
                dicDep.Add Data(i, 4), Nothing
            End If
        End If
    Next
    
End Sub

Open in new window


In DATA sheet module (right click tab name > view code)

Option Explicit

Private Sub Worksheet_Deactivate()
    
    If dicSector Is Nothing Then GET_ALL_DATA
    
    With Worksheets("menu").Range("c4").Validation
        .Delete
        .Add xlValidateList, , , Join(dicSector.keys, ",")
    End With
    
End Sub

Open in new window


in Menu Sheet module (right click tab name > view code)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim Units, Depts, CCentre
    Select Case Target.Address(0, 0)
        Case "C4"
            If Len(Target.Value) Then
                Units = Split(dicSector.Item(Target.Value), ",")
                Application.EnableEvents = False
                Range("C6, C8, C10").ClearContents
                With Range("C6").Validation
                    .Delete
                    .Add 3, , , Join(Units, ",")
                End With
                Application.EnableEvents = True
            End If
        Case "C6"
            If Len(Range("C4").Value) * Len(Target.Value) Then
                Depts = Split(dicUnit.Item(Range("C4").Value & "|" & Target.Value), ",")
                Application.EnableEvents = False
                Range("C8, C10").ClearContents
                With Range("C8").Validation
                    .Delete
                    .Add 3, , , Join(Depts, ",")
                End With
                Application.EnableEvents = True
            End If
        Case "C8"
            If Len(Range("C4").Value) * Len(Range("C6").Value) * Len(Target.Value) Then
                CCentre = Split(dicDept.Item(Range("C4").Value & "|" & Range("C6").Value & "|" & Target.Value), ",")
                Application.EnableEvents = False
                Range("C10").ClearContents
                With Range("C10").Validation
                    .Delete
                    .Add 3, , , Join(CCentre, ",")
                End With
                Application.EnableEvents = True
            End If
    End Select
    
End Sub

Open in new window


Kris
0
 
dec789Author Commented:
Kris,

I don't know what to say but WOW!
It will take me a while to digest all this and implament on a real world workbook.
Your solution works just like I was hoping.

Thank you for your time!
Don
0
 
krishnakrkcCommented:
Thanks for the nice comments.

Kris
0
 
dec789Author Commented:
Kris,

Not to be a bother but...
Takeing a  line of your code in the example below:
How does the LEN() and * (asterisk) work in comparing values in a dictionary?

Example:
If Len(Range("C4").Value) * Len(Range("C6").Value) * Len(Target.Value) Then

Thanks,
Don
0
 
krishnakrkcCommented:
Hi

That line simply checks all the 3 cells have values in it.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.