Dynamic Data Validation List

[Bkisley]

Hello experts!
I have a form my users will fill out. On this form there will be two columns that will require drop downs.
Right now I have the inefficient way of having two completely separate lists when in reality what I need is to have my 2nd drop down dynamic based on the 1st column drop down

On my "Welcome" tab - Cells A50:A100 is my "Main Category" header/values and cells B50:B100 is my "Subcategory" header/values
The user will fill out this welcome tab initially to set up their own personalized document.
Example: The user could type in "Painting" in cell A51 "Plumbing" in cell A52 and "Interior" in B51 and and "Residential" in B52

What I need is for my 2nd drop down to be based on what is chosen in my first drop down SO if the user selects "Painting" in my first drop down the only option based in the above example that would show up is "Interior". The option for "residential should not show up!. The reverse is true if the user selects "Plumbing" only "Residential" should should

Currently my drop downs are pulling from a pivot table that was created so I only have unique values for my Main Category values and a separate pivot table for my Sub category values. Obviously the issue that has is my 2nd drop down could have 50 options that really are not options that are paired with my first drop down selection.

My range of categories has to be dynamic - currently in a table to do this.
There has to be an efficienty way to do this!

 

[maabadi]

if you see error message go to VBA window and show which line is yellow and have problems?
For me working well.

 

[maabadi]

1. First Get backup from your file
2. if you have any Data validation List in your Sheet , Delete All
3.Insert New Module and Paste Macro there
4. Delete Previous macro totally
5. Test Macro at new Module
6. If you see error message again, what line have problem
7. Also search on Internet : Error code 400 VBA
8. Also go and view this Page:
[SOLVED] VBA Error “400” Running an Excel Macro

 

[Bkisley]

Ahh I had other data validation there. I deleted everything from that code. Got rid of the validations. Inserted a new module and pasted the latest code in there.

I no longer get the 400 error, but it stops here....

 Names.Add Name:=n, RefersTo:=Range(Cells(2, j), Cells(k + 1, j))

 

[Akuini]

Hi, Bkisley

Toadstool might have a simpler solution using formula, here:
Dynamic drop-down lists | MrExcel Message Board

 

[maabadi]

Try this:

Sub UniqueListTransposed()
Dim Lr As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim m As Long
Dim L As Long
Dim n As String
Lr = Cells(Rows.Count, 36).End(xlUp).Row

'Convert original code to match my columns A = AJ B=AK C=AL D=AM E=AN F=AO G=AP

ActiveSheet.Range("AJ2:AJ" & Lr).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ThisWorkbook.Worksheets("Data Validation").Range("AN1"), Unique:=True

With ThisWorkbook.Worksheets("Data Validation")
.Range(.Range("AN2"), .Range("AN1").End(xlDown)).Copy
.Range("AO1").PasteSpecial xlPasteValues, Transpose:=True
.Columns("AN").EntireColumn.ClearContents
'.Range("AN1").Value = "MainCategory"
End With
For i = 2 To Lr
Range("AL" & i).Value = Range("AJ" & i).Value & Application.WorksheetFunction.CountIf(Range("AJ2:AJ" & i), Range("AJ" & i))
Next i

For j = 41 To Worksheets("Data Validation"). Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To Application.WorksheetFunction.CountIf(Range("AJ2:AJ" & Lr), Worksheets("Data Validation").Cells(1, j)) + 1
L= Application.WorksheetFunction.CountA(Range(Worksheets("Data Validation").Cells(2, 40), Worksheets("Data Validation"). Cells(Lr, j - 1)))
k = Application.WorksheetFunction.CountIf(Range("AJ2:AJ" & i + L), Worksheets("Data Validation"). Cells(1, j))
m = Application.WorksheetFunction.Match(Worksheets("Data Validation").Cells(1, j) & k, Range("AL2:AL" & Lr), 0)
Worksheets("Data Validation").Cells(i, j).Value = Application.WorksheetFunction.Index(Range("AJ2:AL" & Lr), m, 2)

Next i
n = Replace(Worksheets("Data Validation").Cells(1, j), " ", "")
n = Replace(n, "/", "")
Worksheets("Data Validation").Cells(1, j).Value = n
Names.Add Name:=n, RefersTo:=Range(Worksheets("Data Validation").Cells(2, j), Worksheets("Data Validation").Cells(k + 1, j))
Next j
Worksheets("Data Validation").Activate
Names.Add Name:="MainList", RefersTo:=Range(Cells(1, 41), Cells(1, j))
Range(Cells(1, 41), Cells(16, j)).Interior.ColorIndex = 35
With Range("AO20").Validation
.Delete 'delete previous validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=MainList"

End With
Range("AO20").Value = Cells(1, 41).Value
Range("AO20").Interior.ColorIndex = 6
With Range("AP20").Validation
.Delete 'delete previous validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=Indirect(AO20)"
'xlValidAlertStop,
End With
Range("AP20").Interior.ColorIndex = 6
End Sub

 

[Bkisley]

@maabadi YOU ARE A LEGEND! This works exactly how I need it to and integrated so easy into my file. Can't thank you enough!! Thank you thank you thank you!

@Akuini That works to a point. I need to be able to select a main category in one row and only see those subcategories in the same row. The next row I can pick a different main category and that's where this would fail. Thank you very much for trying to help. I did learn things from working with what you sent, so it is still appreciated!

 

[maabadi]

You 're welcome & thanks for feedback.

 

[Bkisley]

You 're welcome & thanks for feedback.

Sorry one more "weird" little thing...Is there a reason why in my example every main category that is more than one word aka has a space in it, the output that is used for data validation is all one word aka spaces removed? Is there a way to keep it exactly how it is originally?

 

[maabadi]

This is Because Data Validation Don't Accept Space at Names for Main List.
Use this Second Method, Change Sheet2 to your sheet name.

Sub UniqueListTransposed()
Dim Lr As Long
Dim Lr2 As Long
Dim i As Long, j As Long
Dim ws As Worksheet

Lr = Cells(Rows.Count, 36).End(xlUp).Row
Set ws = Sheets("Sheet2")
Range("AN1:AN20").ClearContents
Range("AJ2:AJ" & Lr).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AN1"), Unique:=True
Lr2 = Cells(Rows.Count, 40).End(xlUp).Row
Range("AN1").Value = "MainList"

Names.Add Name:="MainList", RefersTo:=Range("AN2:AN" & Lr2)
Range("AN1:AN" & Lr2).Interior.ColorIndex = 35

With Range("AP2").Validation
.Delete 'delete previous validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=OFFSET(AN2,0,0,COUNTA(AN2:AN6),1)"
End With
ws.Range("AP2").Value = ws.Cells(2, 40).Value
ws.Range("AP2").Interior.ColorIndex = 6
With ws.Range("AQ2").Validation
.Delete 'delete previous validation
   
 .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=OFFSET(AJ1,MATCH(AP2,AJ1:AJ42,0)-1,1,COUNTIF(AJ1:AJ42,AP2),1)"
'xlValidAlertStop,

End With
ws.Range("AQ2").Interior.ColorIndex = 6
End Sub

 

[Bkisley]

Thanks again!! Much appreciated ?