Thread: Variable Drop Down Dependent List with Multiple Criteria

Hi All

Despite doing some research on various sites, I have been unable to track a solution that matches this problem.

I have a attached a sample workbook, using just the basic info needed for this test.

In the Clients2 worksheet, I have drop down list of ID numbers in B1. Based upon the selection made in B1, I need a dependent drop down list in E3 based upon the results in Column D (List Worksheet) that match up with the selected ID (B1) in Column B of the List worksheet.

I would prefer not to use any helper columns, as there are many more columns and functions in use in both the original Pvt2 and List worksheets. Not sure but VBA may be more viable in this situation.

TIA ...David

I don't think you'll be able to do that with forumla, you could do it with vba but you wouldn't be able to do it with a data validate cell as the range wouldn't be contiguous and you can't use an array property for data validation.

Put this in the Clients2 worksheet code module, it will create a named range each time you make a selection, you could then assign that named range to a combobox or something

'Code supplied by Simon Lloyd
'15th January 2012
'Microsoft Office Help
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Mycell As Range, RngLst As String
If Target.Address <> "$B$1" Then Exit Sub
Set Rng = Sheets("List").Range("B1:B" & Sheets("List").Range("B" & Rows.Count).End(xlUp).Row)
For Each Mycell In Rng
If Mycell.Value = Me.Range("B1").Value Then
RngLst = RngLst & ",List!" & Mycell.Offset(0, 2).Address
End If
Next
ActiveWorkbook.Names.Add Name:="mylist", RefersTo:=Right(RngLst, Len(RngLst) - 1)
End Sub

This code will do what you want. It does, however, use two columns on the List sheet. These columns can be easily changed by changing one cell address.

' Sheet3 (Clients2) Sheet Class Module

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
CreateDropDown
End Sub

' mDropDown Module

Option Explicit

Sub CreateDropDown()
Dim awf As WorksheetFunction: Set awf = WorksheetFunction
Dim lLR As Long
' Change the cell address in the next line to move the DV
Dim sWIP As String: sWIP = Range("H1").Address
Dim sDVStart As String
Dim sDVCol As String
Dim sDVRange As String
    
' set up ranges based on sWIP (defined and set above)
With Sheets("List")
    lLR = .Range("A" & .Rows.Count).End(xlUp).Row
    With .Range(sWIP)
        ' set up Data Validation Range
        sDVStart = .Offset(1, 1).Address
        sDVCol = Left(sDVStart, 2) & ":" & Left(sDVStart, 2)
        sDVRange = _
            "=List!" & _
            sDVStart & _
            ":INDEX(List!" & _
            sDVCol & _
            ",COUNTA(List!" & _
            sDVCol & _
            "))"
        ' set up Advanced Filter
        .Value = "ID"
        .Offset(0, 1).Value = "NUM"
        .Offset(1, 0).Value = _
            Sheets("Clients2").Range("B1")
    End With
    ' Extract list using Advanced Filter
    .Range("A1:D" & lLR).AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=.Range(sWIP).Resize(2, 1), _
        CopyToRange:=.Range(sWIP).Offset(0, 1), _
        Unique:=True
End With

' Add the Data Validation Named Range
With ActiveWorkbook
    On Error Resume Next
    .Names("DV_NUM").Delete
    On Error GoTo 0
    .Names.Add _
        Name:="DV_NUM", _
        RefersTo:=sDVRange
End With

' Add the Data Validation to Cell E3
With Sheets("Clients2")
    With .Range("E3").Validation
        .Delete
        .Add _
            Type:=xlValidateList, _
            AlertStyle:=xlValidAlertStop, _
            Operator:=xlBetween, _
            Formula1:="=DV_NUM"
        .IgnoreBlank = False
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
End With

' Clear WIP area but leave Data Validation List
With Sheets("List")
    With .Range(sWIP)
        .Value = ""
        .Offset(1, 0).Value = ""
    End With
End With

End Sub

I have updated your example. See attached


regards, TMS

If you can use a helper Sheet (you can hide this sheet), see the attached.

And another variation ...

This still uses a "temporary work area" but it clears it completely after creating the DV list. The DV list, in this case, is a comma separated string rather than a named range.

It requires the UDF ConcatRange which is also listed below.

Regards, TMS

Sub CreateDropDown2()
Dim awf As WorksheetFunction: Set awf = WorksheetFunction
Dim lLR As Long
' Change the cell address in the next line to move the DV
Dim sWIP As String: sWIP = Range("H1").Address
Dim sDVStart As String
Dim sDVCol As String
Dim sDVRange As String
Dim sDVString As String
    
' set up ranges based on sWIP (defined and set above)
With Sheets("List")
    lLR = .Range("A" & .Rows.Count).End(xlUp).Row
    With .Range(sWIP)
        ' set up Data Validation Range
        sDVStart = .Offset(1, 1).Address
        sDVCol = Left(sDVStart, 2) & ":" & Left(sDVStart, 2)
        sDVRange = _
            "=List!" & _
            sDVStart & _
            ":INDEX(List!" & _
            sDVCol & _
            ",COUNTA(List!" & _
            sDVCol & _
            "))"
        ' set up Advanced Filter
        .Value = "ID"
        .Offset(0, 1).Value = "NUM"
        .Offset(1, 0).Value = _
            Sheets("Clients2").Range("B1")
    End With
    ' Extract list using Advanced Filter
    .Range("A1:D" & lLR).AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=.Range(sWIP).Resize(2, 1), _
        CopyToRange:=.Range(sWIP).Offset(0, 1), _
        Unique:=True
End With

' Add the Data Validation Named Range
With ActiveWorkbook
    On Error Resume Next
    .Names("DV_NUM").Delete
    On Error GoTo 0
    .Names.Add _
        Name:="DV_NUM", _
        RefersTo:=sDVRange
End With

' Concatenate the entries into a string
sDVString = ConcatRange(Range("dv_num"), ",")

' Add the Data Validation to Cell E3
With Sheets("Clients2")
    With .Range("E3").Validation
        .Delete
        .Add _
            Type:=xlValidateList, _
            AlertStyle:=xlValidAlertStop, _
            Operator:=xlBetween, _
            Formula1:=sDVString
        .IgnoreBlank = False
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
End With

' Clear WIP area
With Sheets("List")
    With .Range(sWIP)
        .Resize(1, 2).EntireColumn.Clear
    End With
End With

With ActiveWorkbook
    On Error Resume Next
    .Names("DV_NUM").Delete
    On Error GoTo 0
End With

End Sub

Function ConcatRange(Rng As Range, Optional Separator As String)
Dim awf As WorksheetFunction: Set awf = WorksheetFunction
Dim r As Range

For Each r In Rng
    ConcatRange = ConcatRange & awf.Text(r.Value, "000") & Separator
Next
ConcatRange = Left(ConcatRange, Len(ConcatRange) - Len(Separator))
End Function

Sub test()
MsgBox ConcatRange(Range("DV_NUM"))
End Sub

Sub test2()
MsgBox ConcatRange(Sheets("List").Range("D2:D6"), ",")
End Sub

Note that you need to slightly change the change event.

Regards, TMS

Just change CreateDropDown to CreateDropDown2 in the Worksheet_Change event.

' Sheet3 (Clients2) Sheet Class Module

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
CreateDropDown2
End Sub

Regards, TMS

The main one is that the previously selected value left in E3 (Clients2) does not clear when you make new a selection by changing the ID in B1 (Clients2). So if the dependent list should have 5 numbers in it, it actually starts off as 6 numbers until you make a new selection in E3. I tried adding Me.calculate into the module but this did not work and likewise using <shift>F9 manually does not update the displayed range. Any ideas?

Just need to clear E3 in the Change Event.

Is it possible to adapt the code so that the dependent list is sorted in ascending order, it just makes it easier for people to find the right number, especially if it is a long list.

I guess it should be possible to sort the range. I'll have a look.

The other thing that I find odd is that the dropdown list in E3 is always ranged left, even though the selection in E3 is ranged right, which is numerically correct. I have tried forcing the range to the right by formatting the list in Column D (List) to range right but this did not correct it either. Not sure if it matters but the numbers in this column use a custom format in the style 000 to force the zeros to show where applicable.

Ah, probably my fault as I didn't look closely at the numbers. I used TEXT to retain the leading zeroes in the DV List. I guess I can just remove the TEXT function. The entries will then right align but won't have leading zeroes. It depends what you want/need to do with the selected value. You could always use -- to coerce the value back to a number if you want to add them up.


Regards, TMS

I've coded most of this, just tidying up for my own benefit.

The cell E3 is cleared and the DV List is sorted.

Normally, the first value of the list appears automatically in the cell itself.

I don't believe this to be the case. If you set up DV, the cell will be empty until you select something from the list.

Will post updated code tomorrow.


Regards, TMS