Dynamic dependent drop downs with unique values

[Prestige]

Hi my fellow Excel users,

I've been wrestling with a workbook where I've only one sheet. The sheet has an area which I describe as an user interface and an area which can be described as data area.

The data is (usually) consisted of four columns, but the row count changes from time to time. The data is always printed to same area. It looks like this:

Model_ID	Manufacturer	Class	Model_name
1200	Ford	SUV	Ford SUV model
1300	Nissan	Sedan	Nissan Sedan model
1400	Tesla	Sedan	Tesla Sedan model
1500	VW	SUV	VW SUV model
1600	Toyota	Sport	Toyota Sport model

<colgroup><col><col><col><col></colgroup><tbody>
</tbody>

The UI area is located in the upper left part of the sheet. The UI are contains headers as below. The Result cell (DD3) is the cell where I want to get the group of model names to choose from. In the first drop down (dd1) I want to select from class (and as you can see I need to have unique selections there, for example only SUV, Sedan and Sport) and this should now give only those options in the dd3. In the other hand if I want to only have SUV and from Ford I would get only the Ford SUV model name to dd3. And in the other hand, I want to have only Ford cars, It would present all the Ford cars in drop down dd3 - taken in to account that Class selection (dd1) would then be empty.

Selection
Criteria1 by Class	Criteria2 by Manufacturer	Results
DD1	DD2	DD3

<colgroup><col><col><col></colgroup><tbody>
</tbody>

Does this make any sense? I've worked my way through all the cascading and dependent unique dynamic drop down tutorials, but don't get my head around this.

BR,
Prestige

 

[L. Howard]

Hi Prestiqe,

Yes, makes some sense. The standard dependent drop down scenario didn't cut it with me either. I looked to an Excel guru and with some named ranges, some very clever coding, I have a workbook that does what you want, at least as far as I understand your worksheet requirements.

Just cleaning it up a bit and will post as soon as I can.

Howard

 

[Nixhex11]

Prestige,
If I understand you correctly, try this: Add an additional cell that combines the results of DD1 and DD2. Thus, if DD1 is B1 and DD2 is B2, then in another cell (say C1) put: =concatenate(B1, "_", C1). This will show "Manufacturer_Class", such as "Ford_SUV", or "Nissan_Sedan", etc. I'll get to the underscore in a second. If for aesthetic reasons you don't want B2 to show, either hide it in its own row or color the font white.
Then, make lists of models for every combination of manufacturer and class needed. For example, Sentra, Altima, Maxima will be your Nissan Sedan list, and so on. Each of these models list you will need to name: To name, formulas/name manager/new.../add name and make sure it refers to the correct range of models. Also, very important: make sure to match the name with the Manufacturer and Class but with an underscore in the name between the two such as Nissan_Sedan (name manager won't let you use spaces), in other words, exactly how it'll show up in C1.
-For DD3, click the cell where you the models list to show, then data validation, allow: list and in source: type: =indirect(c1), ok.
This should work.

If you want to get fancy, add this as code:

Private Sub Worksheet_Change(ByVal Target As Range)

'   Dim Cell As Range
    For Each Cell In Target
        If Cell.Address = "$B$1" Then
            Application.EnableEvents = False
                Range("DD3 cell").ClearContents
            Application.EnableEvents = True
        End If
    Next Cell

'   Dim Cell As Range
    For Each Cell In Target
        If Cell.Address = "$B$2" Then
            Application.EnableEvents = False
                Range("DD3 cell").ClearContents
            Application.EnableEvents = True
        End If
    Next Cell


End Sub

This will clear the contents of DD3 if either DD1 or DD2 are changed. That way you can't have Altima chosen in DD3 if DD1 is Ford and DD2 is SUV.

 

[L. Howard]

Hi Prestiqe,

Here is a link to a workbook, seems to do what you ask.

https://www.dropbox.com/s/8ja50ny8cgr723v/Drop Down Double Duty DBox.xlsm?dl=0

Howard

These are the codes in the workbook.
Thanks to Claus @ MS Public

Sheet1 Module

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B:B,C:C,F2,G2")) Is Nothing _
    Then Exit Sub
    
Dim LRow As Long, i As Long
Select Case Target.Column
    Case 2
        With Sheets("Sheet2")
            Columns("B:B").AdvancedFilter Action:=xlFilterCopy, _
                CopyToRange:=.Range("B1"), Unique:=True
            .Range("B2:B1000").Sort key1:=.Range("B2"), order1:=xlAscending, Header:=xlYes
        End With
    Case 3
        With Sheets("Sheet2")
            Columns("C:C").AdvancedFilter Action:=xlFilterCopy, _
                CopyToRange:=.Range("A1"), Unique:=True
            .Range("A2:A1000").Sort key1:=.Range("A2"), order1:=xlAscending, Header:=xlYes
        End With
End Select
Select Case Target.Address(0, 0)
    Case "F2"
        ValidationG
        Range("G2") = "<**>"
        ValidationH
    Case "G2"
        ValidationH
End Select
End Sub

ThisWorkbook module

Option Explicit

Private Sub Workbook_Open()
CreateValidation
End Sub

In a standard module, or each in its own standard module

Option Explicit
Sub CreateValidation()
With Sheets("Sheet1")
       
    With .Range("F2").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=Class"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    With .Range("G2").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=Manu"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    .Range("F2:G2") = "<**>"
End With
End Sub



Sub ValidationG()
Dim LRow As Long, i As Long, n As Long
Dim varData As Variant, varOut() As Variant, varTmp As Variant
Dim strG As String, strTmp As String
Dim myDic As Object
Set myDic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
    LRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    varData = .Range("B2:C" & LRow)
    If Range("F2") <> "<**>" Then
        For i = LBound(varData) To UBound(varData)
            ReDim Preserve varOut(n)
            If varData(i, 2) = Range("F2") Then
                varOut(n) = varData(i, 1)
                n = n + 1
            End If
        Next
        For i = LBound(varOut) To UBound(varOut)
            myDic(varOut(i)) = varOut(i)
        Next
        varTmp = myDic.items
        strG = "<**>," & Join(varTmp, ",")
        With .Range("G2").Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:=strG
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    Else
        With .Range("G2").Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="=Manu"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    End If
End With
End Sub



Sub ValidationH()
Dim LRow As Long, i As Long, n As Long
Dim varData As Variant, varOut() As Variant
Dim strH As String
With Sheets("Sheet1")
    LRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    varData = .Range("B2:D" & LRow)
    n = 0
    If .Range("F2") <> "<**>" And .Range("G2") = "<**>" Then
        For i = LBound(varData) To UBound(varData)
            ReDim Preserve varOut(n)
            If varData(i, 2) = .Range("F2") Then
                varOut(n) = varData(i, 3)
                n = n + 1
            End If
        Next
    ElseIf .Range("F2") = "<**>" And .Range("G2") <> "<**>" Then
        For i = LBound(varData) To UBound(varData)
            ReDim Preserve varOut(n)
            If varData(i, 1) = .Range("G2") Then
                varOut(n) = varData(i, 3)
                n = n + 1
            End If
        Next
    ElseIf .Range("F2") <> "<**>" And .Range("G2") <> "<**>" Then
        For i = LBound(varData) To UBound(varData)
            ReDim Preserve varOut(n)
            If varData(i, 1) = .Range("G2") And varData(i, 2) = .Range("F2") Then
                varOut(n) = varData(i, 3)
                n = n + 1
            End If
        Next
    End If
    
    If n > 0 Then
        With Sheets("Sheet2")
            .Range("C2:C1000").ClearContents
            .Range("C2").Resize(UBound(varOut) + 1, 1).Value = Application.Transpose(varOut)
            .Range("C2:C1000").Sort key1:=.Range("C2"), order1:=xlAscending, Header:=xlYes
        End With
    
        With .Range("H2").Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="=myList"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    Else
         With .Range("H2")
            .Validation.Delete
            .Value = ""
        End With
    End If
End With
End Sub

 

[Nixhex11]

A quick tweak after rereading your initial post. I realize in my above post I switched the order of your dropdowns DD1 being Manufacturer and DD2 being Class, so make whatever adjustments necessary. You'll need to put this formula into C1 instead: =If(B2="", B1, concatenate(B1, "_", C1)). Then, along with the models lists for all the different Manufacturer_Class combinations you need to make, you'll also need to make separate models lists for each Manufacturer and name them accordingly as described above (w/o the underscore and class of course). The rest should still work.