Unique dynamic data validation list

[Polanskiman]

Hello,

I have 2 sheets. Sheet 1 is the source data, Sheet 2 is a user sheet. I need in Sheet 2 multiple drop down lists as following:

Book1
	D	E
3	Product name	Element
4	Product 1	Mn
5	Product 2	Mn
6	Product 3	Zn
7	Product 4	Zn
8	Product 5	B
9	Product 6	Cu
10	Product 7	Cu
11	Product 8	Mo
12	Product 9	Mo
13	Product 10	Ni
14	Product 11	Co
Sheet1

Book1
	D	E
3	Product	Element
4	Dropdown list of all Mn products from sheet 1	Mn
5	Dropdown list of all Zn products from sheet 1	Zn
6	Dropdown list of all B products from sheet 1	B
7	Dropdown list of all Cu products from sheet 1	Cu
8	Dropdown list of all Mo products from sheet 1	Mo
9	Dropdown list of all Ni products from sheet 1	Ni
10	Dropdown list of all Ni products from sheet 1	Co
Sheet2

Obviously I could make very easily multiple ranges for each drop down, but I would like to have a single formula than I can use for all drop down lists. How can I achieve that?

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for Sheet2 and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Click on a cell in column D of Sheet2.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim LastRow As Long, srcWS As Worksheet, arr As Variant, i As Long, dic As Object, key As Variant
    Dim cnt As Long, fVisRow As Long, rng As Range, val As String, x As Long: x = 4
    Set srcWS = Sheets("Sheet1")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    arr = srcWS.Range("E4:E" & LastRow).Value
    If Intersect(Target, Range("D:D")) Is Nothing Then Exit Sub
    If Target.Row >= 4 Then
        Application.ScreenUpdating = False
        Set dic = CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(arr, 1)
            If Not dic.Exists(arr(i, 1)) Then
                dic.Add arr(i, 1), Nothing
            End If
        Next i
        For Each key In dic.keys
            With srcWS
                .Cells(3, 4).CurrentRegion.AutoFilter 2, key
                fVisRow = .Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Row
                cnt = .[subtotal(103,A:A)] + 2
                For Each rng In .Range("D4:D" & LastRow).SpecialCells(xlCellTypeVisible)
                    If val = "" Then val = rng Else val = val & "," & rng
                Next rng
                With Range("D" & x).Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=val
                End With
            End With
            val = ""
            x = x + 1
        Next key
    End If
    srcWS.Range("D3").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[Polanskiman]

Thank you but can't this not be done without VBA?

 

[mumps]

No. You need a macro to do what you want.

 

[Fluff]

I know of know way to do what you want with a single formula. You would either need a formula for each dropdown, or VBA.

 

[Polanskiman]

I know of know way to do what you want with a single formula. You would either need a formula for each dropdown, or VBA.

I suppose you mean you "don't know"?

By single formula I meant the same formula for each dropdown so that I don't need to customize the formula for each of them.

 

[Peter_SSs]

By single formula I meant the same formula for each dropdown so that I don't need to customize the formula for each of them.

Well, sort of a cross. If you did something like this on Sheet1

Polanskiman_2.xlsm
	D	E	F	G	H	I	J
1
2
3	Product name	Element
4	Product 1	Mn		Mn	Product 1	Product 2
5	Product 2	Mn		Zn	Product 3	Product 4
6	Product 3	Zn		B	Product 5
7	Product 4	Zn		Cu	Product 6	Product 7
8	Product 5	B		Mo	Product 8	Product 9
9	Product 6	Cu		Ni	Product 10
10	Product 7	Cu		Co	Product 11
11	Product 8	Mo
12	Product 9	Mo
13	Product 10	Ni
14	Product 11	Co
Sheet1

Cell Formulas
Range	Formula
G4:G10	G4	=UNIQUE(E4:E14)
H7:I8,H6,H9:H10,H4:I5	H4	=TRANSPOSE(FILTER($D$4:$D$14,$E$4:$E$14=G4,""))
Dynamic array formulas.

Then on Sheet2 you could have the same DV formula for all rows.
Here I have used the spill ability of Excel 365. See more on this below.

Polanskiman_2.xlsm
	D	E
3	Product	Element
4		Mn
5		Zn
6		B
7		Cu
8		Mo
9		Ni
10		Co
Sheet2

Cells with Data Validation
Cell	Allow	Criteria
D4:D10	List	=INDEX(Sheet1!$H:$H,MATCH(E4,Sheet1!$G:$G,0))#

If this general idea is any use and it needs to operate in versions that do not spill then it still can be done but with a fair bit more work on Sheet1.
Post back if you want more about that.

 

[Polanskiman]

@Peter_SSs
The above solution is really sweet only issue is if I want to make this the most compatible as possible with older versions of Excel this will not work I suppose due to the spill, right? What's the lowest version of Excel the solution will work on?

 

[Peter_SSs]

What's the lowest version of Excel the solution will work on?

Excel 365, but as i said above ..

If this general idea is any use and it needs to operate in versions that do not spill then it still can be done but with a fair bit more work on Sheet1.
Post back if you want more about that.

.. so for earlier versions

Polanskiman_4.xlsm
	D	E	F	G	H	I	J	K	L	M
1
2
3	Product name	Element
4	Product 1	Mn		Mn	2	Product 1	Product 2
5	Product 2	Mn		Zn	2	Product 3	Product 4
6	Product 3	Zn		B	1	Product 5
7	Product 4	Zn		Cu	2	Product 6	Product 7
8	Product 5	B		Mo	2	Product 8	Product 9
9	Product 6	Cu		Ni	1	Product 10
10	Product 7	Cu		Co	1	Product 11
11	Product 8	Mo
12	Product 9	Mo
13	Product 10	Ni
14	Product 11	Co
Sheet1

Cell Formulas
Range	Formula
G4:G14	G4	=IFERROR(INDEX(E$4:E$14,MATCH(0,INDEX(COUNTIF($G$3:G3,E$4:E$14)+(E$4:E$14=""),0),0)),"")
H4:H14	H4	=IF(G4="","",COUNTIF(I4:M4,"?*"))
I4:M14	I4	=IFERROR(INDEX($D$4:$D$14,AGGREGATE(15,6,(ROW($D$4:$D$14)-ROW($D$4)+1)/($E$4:$E$14=$G4),COLUMNS($I4:I4))),"")

Polanskiman_4.xlsm
	D	E
1
2
3	Product	Element
4		Mn
5		Zn
6		B
7		Cu
8		Mo
9		Ni
10		Co
Sheet2

Cells with Data Validation
Cell	Allow	Criteria
D4:D10	List	=OFFSET(INDEX(Sheet1!$I:$I,MATCH(E4,Sheet1!$G:$G,0)),,,,INDEX(Sheet1!$H:$H,MATCH(E4,Sheet1!$G:$G,0)))

 

[Polanskiman]

Yes that seems seriously more involved. It does works as expected though. Thumbs up for that.
Question regarding the OFSSET formula or the INDEX formula for the first option. Why are you using full column references rather than just a specified range?