Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Excel 2007 Combo Boxes and Filtering a Data Set

Posted on 2012-09-10
5
Medium Priority
?
627 Views
Last Modified: 2012-09-11
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
0
Comment
Question by:dec789
  • 3
  • 2
5 Comments
 
LVL 18

Accepted Solution

by:
krishnakrkc earned 2000 total points
ID: 38385974
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
 

Author Closing Comment

by:dec789
ID: 38386848
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
 
LVL 18

Expert Comment

by:krishnakrkc
ID: 38387081
Thanks for the nice comments.

Kris
0
 

Author Comment

by:dec789
ID: 38387507
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
 
LVL 18

Expert Comment

by:krishnakrkc
ID: 38387768
Hi

That line simply checks all the 3 cells have values in it.
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Windows Explorer lets you open cabinet (cab) files like any other folder. In VBA you can easily handle normal files and folders, but opening and indeed creating cabinet files takes a lot more - and that's you'll find here.
Currently, there is an issue with being able to copy values from an external application to a dropdown list in Project Web Access (PWA).  The standard copy and paste methods don't seem to work properly. Here is a way to accomplish this task to s…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

581 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question