Excel: How to create a dependent drop down list in Excel when the primary has duplicates?

Question

I've researched several posts about dependent drop-down lists; however, I'm still stuck. I need to create drop-down list based on a primary list that has duplicates. Most of the examples have the data enter image description hereoriented differently and are unique.

See the screenshot of the following table:

I want the primary drop down to show a non-duplicate list: e.g., cassette

THEN, I want the dependent list to show the drive options. e.g., clutch, vertilux motor, etc.

Best, Jason

Answer 1

EDIT: updated to a more generic approach, to enable multiple lists as data sources.

Here's one way to do this - it relies on using a named range which refers to a VBA function: that function is called when you click a validation drop-down which refers to the name.

Needs a name defined (all the Data Validation lists point at this same name):

Lists sheet:

Data Entry sheet:

Code (all in a regular module):

Option Explicit


Sub Tester() 'for running the code in a debuggable way....
    Debug.Print getOptions().Address
End Sub


Function getOptions() As Range
    
    Dim c As Range, dict As Object, rw As Range, rngVals As Range, sz As Long
    
    Set rngVals = ListsSheet.Range("H4")
    rngVals.Resize(100).ClearContents   'clear previous options
    
    'On Error Resume Next                                                       'uncomment for debugging
    Set c = Application.Caller 'this function is called from the cell
                               '  where the drop-down is clicked
    'On Error GoTo 0                                                            'uncomment for debugging
    'If c Is Nothing Then Set c = ThisWorkbook.Sheets("Data Entry").Range("A4") 'uncomment for debugging
    Set rw = c.EntireRow
    
    Select Case c.Column                'whaich column is the dd in ?
        Case 1: Set dict = GetTypes()                    'no parent values
        Case 2: Set dict = GetColors(rw.Cells(1).Value)  'one parent value
        Case 3: Set dict = GetSizes(rw.Cells(1).Value, rw.Cells(2).Value) 'two parent values
        Case 5: Set dict = GetFinishes(rw.Cells(1).Value) 'Finishes depend on Type and are from a different list
        Case Else: Set dict = CreateObject("scripting.dictionary")
    End Select
    Debug.Print dict.Count
    
    If dict.Count > 0 Then 'any values to list out?
        rngVals.Cells(1).Resize(dict.Count, 1).Value = Application.Transpose(dict.keys)
    End If
    sz = IIf(dict.Count = 0, 1, dict.Count)
    Set getOptions = rngVals.Resize(sz)   'return a range for the drop-down to reference

End Function

'returns the sheet with the lookup lists
Function ListsSheet() As Worksheet
    Set ListsSheet = ThisWorkbook.Sheets("Lists")
End Function

'following 4 functions return different lists depending on source and filtering
Function GetTypes() As Object
    Set GetTypes = Uniques(ListsSheet.ListObjects("Table1").DataBodyRange, 1)
End Function

Function GetColors(typ) As Object
    Set GetColors = Uniques(ListsSheet.ListObjects("Table1").DataBodyRange, 2, 1, typ)
End Function

Function GetSizes(typ, clr) As Object
    Set GetSizes = Uniques(ListsSheet.ListObjects("Table1").DataBodyRange, 3, 1, typ, 2, clr)
End Function

Function GetFinishes(typ) As Object
    Set GetFinishes = Uniques(ListsSheet.ListObjects("Table2").DataBodyRange, 2, 1, typ)
End Function

'Given a range `rng`, return a scripting dictionary with all unique values from column# `valueCol`,
'  where (optionally) the row meets criteria supplied to `filters` (zero or more pairs of colNum, colValue)
Function Uniques(rng As Range, valueCol As Long, ParamArray filters() As Variant) As Object
    Dim dict As Object, arr, r As Long, c, filtering As Boolean
    Dim adding As Boolean, i As Long, colnum As Long, v
    Set dict = CreateObject("scripting.dictionary")
    filtering = UBound(filters) <> -1
    arr = rng.Value
    For r = 1 To UBound(arr, 1)
        adding = True      'by default we add...
        If filtering Then
            For i = LBound(filters) To UBound(filters) Step 2
                colnum = filters(i) 'column index to filter on
                v = filters(i + 1)  'value to filter on
                If arr(r, colnum) <> v Then
                    adding = False 'row did not match criteria
                    Exit For
                End If
            Next i
        End If
        If adding Then dict(arr(r, valueCol)) = True
    Next r
done:
    Set Uniques = dict
End Function