You need validation lists to change based on selections... like a cascading validation list
me@jaykilleen.com wrote this over 5 years ago and it was last updated about 4 years ago.
Code dumped. Comment below if you want more details about what this does.
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call Module2.UpdateDropdowns
End Sub
Option Explicit
Global wb As Workbook 'ThisWorkbook
Global x As Long 'a placeholder for looping through rows
Global v As String 'a placeholder for storing a value from a row within a loop cycle
Global ws_map, ws_ph As Worksheet 'the worksheets being worked on
Global lr As Long 'last row of mapping worksheet
Sub init()
Set wb = ActiveWorkbook
Set ws_map = wb.Sheets("Map")
Set ws_ph = wb.Sheets("PH")
lr = get_last_row(ws_ph, 1)
End Sub
Sub UpdateDropdowns()
Dim ph1, ph2, ph3, ph4, ph5 As String 'stores the array of values as a string for each product heirarchy
Dim rph1, rph2, rph3, rph4 As String 'stores the product heirarchy value for the current row of the mapping table
Dim cr As Long 'current row of mapping worksheet
Dim cc As Integer 'current column of mapping worksheet
init
cc = ActiveCell.column
If cc = 5 Then
ph1 = get_ph1_dropdown_values
If ph1 <> "" Then
With ActiveCell.Validation
.Delete 'delete previous validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=ph1
End With
End If
End If
If cc = 6 Then
rph1 = ActiveCell.Offset(0, -1)
If rph1 <> "" Then
ph2 = get_ph2_dropdown_values(rph1)
If ph2 <> "" Then
With ActiveCell.Validation
.Delete 'delete previous validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=ph2
End With
End If
End If
End If
If cc = 7 Then
rph1 = ActiveCell.Offset(0, -2)
rph2 = ActiveCell.Offset(0, -1)
If rph2 <> "" Then
ph3 = get_ph3_dropdown_values(rph1, rph2)
If ph3 <> "" Then
With ActiveCell.Validation
.Delete 'delete previous validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=ph3
End With
End If
End If
End If
If cc = 8 Then
rph1 = ActiveCell.Offset(0, -3)
rph2 = ActiveCell.Offset(0, -2)
rph3 = ActiveCell.Offset(0, -1)
If rph3 <> "" Then
ph4 = get_ph4_dropdown_values(rph1, rph2, rph3)
If ph4 <> "" Then
With ActiveCell.Validation
.Delete 'delete previous validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=ph4
End With
End If
End If
End If
If cc = 9 Then
rph1 = ActiveCell.Offset(0, -4)
rph2 = ActiveCell.Offset(0, -3)
rph3 = ActiveCell.Offset(0, -2)
rph4 = ActiveCell.Offset(0, -1)
If rph4 <> "" Then
ph5 = get_ph5_dropdown_values(rph1, rph2, rph3, rph4)
If ph5 <> "" Then
With ActiveCell.Validation
.Delete 'delete previous validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=ph5
End With
End If
End If
End If
End Sub
Function get_ph1_dropdown_values() As String
'loop through PH LEVEL 1 and grab a unique list of all the values
For x = 2 To lr
v = "'" & ws_ph.Cells(x, get_column_number(ws_ph, "LEVEL 1", 1, True)).value & "'"
If get_ph1_dropdown_values = "" Then get_ph1_dropdown_values = v
If InStr(get_ph1_dropdown_values, v) = False Then
get_ph1_dropdown_values = get_ph1_dropdown_values & "," & v
End If
Next x
get_ph1_dropdown_values = Replace(get_ph1_dropdown_values, "'", "")
End Function
Function get_ph2_dropdown_values(rph1) As String
'loop through PH LEVEL 2 and grab a unique list of all the values based on the value selected in PH1
For x = 2 To lr
If ws_ph.Cells(x, get_column_number(ws_ph, "LEVEL 1", 1, True)).value = rph1 Then
v = "'" & ws_ph.Cells(x, get_column_number(ws_ph, "LEVEL 2", 1, True)).value & "'"
If get_ph2_dropdown_values = "" Then get_ph2_dropdown_values = v
If InStr(get_ph2_dropdown_values, v) = False Then
get_ph2_dropdown_values = get_ph2_dropdown_values & "," & v
End If
End If
Next x
get_ph2_dropdown_values = Replace(get_ph2_dropdown_values, "'", "")
End Function
Function get_ph3_dropdown_values(rph1, rph2) As String
'loop through PH LEVEL 3 and grab a unique list of all the values based on the value selected in PH1 & PH2
For x = 2 To lr
If ws_ph.Cells(x, get_column_number(ws_ph, "LEVEL 1", 1, True)).value = rph1 Then
If ws_ph.Cells(x, get_column_number(ws_ph, "LEVEL 2", 1, True)).value = rph2 Then
v = "'" & ws_ph.Cells(x, get_column_number(ws_ph, "LEVEL 3", 1, True)).value & "'"
If get_ph3_dropdown_values = "" Then get_ph3_dropdown_values = v
If InStr(get_ph3_dropdown_values, v) = False Then
get_ph3_dropdown_values = get_ph3_dropdown_values & "," & v
End If
End If
End If
Next x
get_ph3_dropdown_values = Replace(get_ph3_dropdown_values, "'", "")
End Function
Function get_ph4_dropdown_values(rph1, rph2, rph3) As String
'loop through PH LEVEL 4 and grab a unique list of all the values based on the value selected in PH1,PH2 & PH3
For x = 2 To lr
If ws_ph.Cells(x, get_column_number(ws_ph, "LEVEL 1", 1, True)).value = rph1 Then
If ws_ph.Cells(x, get_column_number(ws_ph, "LEVEL 2", 1, True)).value = rph2 Then
If ws_ph.Cells(x, get_column_number(ws_ph, "LEVEL 3", 1, True)).value = rph3 Then
v = "'" & ws_ph.Cells(x, get_column_number(ws_ph, "LEVEL 4", 1, True)).value & "'"
If get_ph4_dropdown_values = "" Then get_ph4_dropdown_values = v
If InStr(get_ph4_dropdown_values, v) = False Then
get_ph4_dropdown_values = get_ph4_dropdown_values & "," & v
End If
End If
End If
End If
Next x
get_ph4_dropdown_values = Replace(get_ph4_dropdown_values, "'", "")
End Function
Function get_ph5_dropdown_values(rph1, rph2, rph3, rph4) As String
'loop through PH LEVEL 5 and grab a unique list of all the values based on the value selected in PH1,PH2,PH3 & PH4
For x = 2 To lr
If ws_ph.Cells(x, get_column_number(ws_ph, "LEVEL 1", 1, True)).value = rph1 Then
If ws_ph.Cells(x, get_column_number(ws_ph, "LEVEL 2", 1, True)).value = rph2 Then
If ws_ph.Cells(x, get_column_number(ws_ph, "LEVEL 3", 1, True)).value = rph3 Then
If ws_ph.Cells(x, get_column_number(ws_ph, "LEVEL 4", 1, True)).value = rph4 Then
v = "'" & ws_ph.Cells(x, get_column_number(ws_ph, "LEVEL 5", 1, True)).value & "'"
If get_ph5_dropdown_values = "" Then get_ph5_dropdown_values = v
If InStr(get_ph5_dropdown_values, v) = False Then
get_ph5_dropdown_values = get_ph5_dropdown_values & "," & v
End If
End If
End If
End If
End If
Next x
get_ph5_dropdown_values = Replace(get_ph5_dropdown_values, "'", "")
End Function