5 Level Cascading Validation Lists in Excel using VBA

You need validation lists to change based on selections... like a cascading validation list

me@jaykilleen.com wrote this almost 4 years ago and it was last updated over 2 years ago.


← Back to the Posts

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