Cascading down down lists

**troygeri** · 06-07-2011, 09:05 AM

I have created a spreadsheet with a set of three cascading drop down lists vased on the approach outined in http://www.contextures.com/xlDataVal02.html

I have the following

1. Concept Area (List 1)
2. Subject area within each concept area (List 2)
3. Entity within each subject area (List 3)

Issue I have is I have VB on the worksheet to handle when a drop down is reset, it clears the next dependant drop down (here is the code)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim oneCell As Range
    On Error GoTo ErrorOut
    For Each oneCell In ActiveSheet.Cells.SpecialCells(xlCellTypeAllValidation)
        If Not oneCell.Validation.Value Then oneCell.ClearContents
    Next oneCell
ErrorOut:
Application.EnableEvents = True
On Error GoTo 0
End Sub

However if I reset the value in list 1 I need it to clear list 2 and 3, the above code only clears list 2, not 2 and 3. My workaround was to add an if statement to list 3 data validation source (e.g. =if(B2="","",remainingcode). The problem is this approach seems to cause the whole spreadsheet to freeze and go into a loop when I reset values.

Here is a link to the spreadsheet, would appreciate any assistance in resolving this. The tab that has the drop downs is called "CascadeSelect", the data supporting the drop down (i.e. named ranges) are in Sheet2

**tigeravatar** · 06-07-2011, 06:34 PM

troygeri,

Give this a try:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim rngLists As Range: Set rngLists = Me.Cells.SpecialCells(xlCellTypeAllValidation)
    
    If Not Intersect(Target, rngLists) Is Nothing Then
        Application.EnableEvents = False
        Dim ListCell As Range
        For Each ListCell In Target
            If Not Intersect(ListCell, rngLists) Is Nothing _
            And ListCell.Value = vbNullString Then
                Dim ColIndex As Long
                For ColIndex = rngLists.Column To rngLists.Column + rngLists.Columns.Count - 1
                    If ColIndex >= ListCell.Column Then
                        ListCell.Offset(0, ColIndex - ListCell.Column).Value = "Please select a value"
                    End If
                Next
            End If
        Next ListCell
        Application.EnableEvents = True
    End If
    
End Sub

Hope that helps,
~tigeravatar

**troygeri** · 06-07-2011, 07:53 PM

Thanks - I added the code below to the sheet in VB Editor but it doesn't appear to be doing anything, when I change a list value in list 1 or 2 the cells to the right just stay the same, I just wondered whether i have put the code in the correct pleace? If so, not sure why the code doesn't appear to be doing anything

Thanks so much for your helps so far

Troy

**tigeravatar** · 06-07-2011, 08:29 PM

Troy,

I misunderstood your intention the first time. I updated the code. Give this a try:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim rngLists As Range: Set rngLists = Me.Cells.SpecialCells(xlCellTypeAllValidation)
    
    If Not Intersect(Target, rngLists) Is Nothing Then
        Application.EnableEvents = False
        Dim ListCell As Range, ColIndex As Long
        For Each ListCell In Target
            If Not Intersect(ListCell, rngLists) Is Nothing Then
                If ListCell.Value = vbNullString Then
                    For ColIndex = rngLists.Column To rngLists.Column + rngLists.Columns.Count - 1
                        If ColIndex >= ListCell.Column Then
                            ListCell.Offset(0, ColIndex - ListCell.Column).Value = "Please select a value"
                        End If
                    Next
                Else
                    For ColIndex = rngLists.Column To rngLists.Column + rngLists.Columns.Count - 1
                        If ColIndex > ListCell.Column Then
                            ListCell.Offset(0, ColIndex - ListCell.Column).Value = "Please select a value"
                        End If
                    Next
                End If
            End If
        Next ListCell
        Application.EnableEvents = True
    End If
    
End Sub

Hope this helps,
~tigeravatar