• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Clearing any downstream choices when an upstream one changes in dynamic cascading dropdowns

W

wollyka

Member
Hi
I am using the great dynamic cascading dropdowns method posted here
http://chandoo.org/wp/2014/02/13/dynamic-cascading-dropdowns-that-reset/

However, my table has a different layout, the subcategories are not to the right of the Main category list but they are below it. Everything works fine except the VBA Code used. The Code is used for clearing any downstream choices should an upstream one changes.

Code: 
Option Explicit

Const CHOOSE = "Choose…"

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ErrorHandler
    Dim targetCell As Range
    Dim nextCell As Range
    Dim oldCalc As Excel.XlCalculation
 
    If Not Intersect(Target, [DataEntryTable]) Is Nothing Then
        If [Radio_Choice] = 1 Then
            With Application
                .EnableEvents = False
                .ScreenUpdating = False
                oldCalc = .Calculation
                .Calculation = xlCalculationManual
            End With
         
            For Each targetCell In Target
                'Clear any cells that use 'SubList' to the right of targetCell in the current table.
                If targetCell.Column < (targetCell.ListObject.ListColumns.Count + targetCell.ListObject.Range.Column - 1) Then 'there are table cells to the right
                    For Each nextCell In targetCell.Offset(, 1).Resize(, targetCell.ListObject.ListColumns.Count + targetCell.ListObject.Range.Column - targetCell.Column - 1)
                        If HasValidationFormula(nextCell) Then
                            If nextCell.Validation.Formula1 = "=SubList" Then nextCell.Value = ""
                        End If
                    Next nextCell
                End If
             
                'Perform different action depeding on whether we're dealing with a 'MainList' dropdown
                ' or a 'SubList' dropdown
                If HasValidationFormula(targetCell) Then
                    Select Case targetCell.Validation.Formula1
                    Case "=MainList"
                        If targetCell.Value = "" Then
                            targetCell.Value = CHOOSE
                        ElseIf targetCell.Value = CHOOSE Then
                            'Do nothing.
                        Else
                            targetCell.Offset(, 1).Value = CHOOSE
                        End If
                     
                    Case "=SubList"
                        If targetCell.Value = "" Then
                            targetCell.Value = CHOOSE
                        ElseIf targetCell.Offset(, -1).Value = CHOOSE Then
                            targetCell.Value = ""
                        ElseIf targetCell.Value = CHOOSE Then
                            'Do nothing
                        Else
                            Set nextCell = targetCell.Offset(, 1)
                            If HasValidationFormula(nextCell) Then
                                If nextCell.Validation.Formula1 = "=SubList" Then nextCell.Value = CHOOSE
                            End If
                        End If
                    End Select
                End If
            Next targetCell
            With Application
                .EnableEvents = True
                .ScreenUpdating = True
                .Calculation = oldCalc
            End With
        End If
    End If
    Exit Sub
ErrorHandler:
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        If oldCalc <> 0 Then .Calculation = oldCalc
    End With
    MsgBox Err.Description, vbCritical, Name & ".Worksheet_Change()"
End Sub

Private Function HasValidationFormula(cell As Range) As Boolean
    On Error GoTo ValidationNotExistsError
    If cell.Validation.Formula1 <> "" Then
        HasValidationFormula = True
    Else
        HasValidationFormula = False
    End If
    Exit Function
ValidationNotExistsError:
    HasValidationFormula = False
End Function

Any help is greatly appreciated since it seems i cannot make to work
Thanks
 

Attachments

Last edited:
Welcome to the forum, and glad you liked the article.

To switch to a vertical layout, we'll change all the "column" references to be "row", and change the Offset method to go by rows rather than columns. Note: Only had to change the macro, the function can be left alone.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ErrorHandler
    Dim targetCell As Range
    Dim nextCell As Range
    Dim oldCalc As Excel.XlCalculation
   
    If Not Intersect(Target, [DataEntryTable]) Is Nothing Then
        If [Radio_Choice] = 1 Then
            With Application
                .EnableEvents = False
                .ScreenUpdating = False
                oldCalc = .Calculation
                .Calculation = xlCalculationManual
            End With
           
            For Each targetCell In Target
                'Clear any cells that use 'SubList' to the right of targetCell in the current table.
                If targetCell.Row < (targetCell.ListObject.ListRows.Count + targetCell.ListObject.Range.Row - 1) Then 'there are table cells below
                    For Each nextCell In targetCell.Offset(1).Resize(targetCell.ListObject.ListRows.Count + targetCell.ListObject.Range.Row - targetCell.Row - 1)
                        If HasValidationFormula(nextCell) Then
                            If nextCell.Validation.Formula1 = "=SubList" Then nextCell.Value = ""
                        End If
                    Next nextCell
                End If
               
                'Perform different action depeding on whether we're dealing with a 'MainList' dropdown
                ' or a 'SubList' dropdown
                If HasValidationFormula(targetCell) Then
                    Select Case targetCell.Validation.Formula1
                    Case "=MainList"
                        If targetCell.Value = "" Then
                            targetCell.Value = CHOOSE
                        ElseIf targetCell.Value = CHOOSE Then
                            'Do nothing.
                        Else
                            targetCell.Offset(1).Value = CHOOSE
                        End If
                       
                    Case "=SubList"
                        If targetCell.Value = "" Then
                            targetCell.Value = CHOOSE
                        ElseIf targetCell.Offset(-1).Value = CHOOSE Then
                            targetCell.Value = ""
                        ElseIf targetCell.Value = CHOOSE Then
                            'Do nothing
                        Else
                            Set nextCell = targetCell.Offset(1)
                            If HasValidationFormula(nextCell) Then
                                If nextCell.Validation.Formula1 = "=SubList" Then nextCell.Value = CHOOSE
                            End If
                        End If
                    End Select
                End If
            Next targetCell
            With Application
                .EnableEvents = True
                .ScreenUpdating = True
                .Calculation = oldCalc
            End With
        End If
    End If
   
     
    Exit Sub
ErrorHandler:
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        If oldCalc <> 0 Then .Calculation = oldCalc
    End With
    MsgBox Err.Description, vbCritical, Name & ".Worksheet_Change()"
End Sub
 
Hi
Thanks for the help but it doesn't work as expected. It only clears the first "row" below the main list. If you have multiple subcategories , the new VBA does not reset them
 
Hi ,

See the attached file ; one line needed to be changed as follows :

If Not Intersect(Target, Range("DataEntryTable").ListObject.Range) Is Nothing Then

Narayan
 

Attachments

Hi
Thanks for taking the time, but i must be doing something wrong since it is not working. the code still resets the row below only (first row)!!
 
Thank you very much, it is working as expected but may i ask how did you do it? For the first file you uploaded i had to add another row in the table and hide it to make it work.

Thank you again
 
Hi ,

The problem was in these two lines of code :

If targetCell.Row < (targetCell.ListObject.ListRows.Count + targetCell.ListObject.Range.Row) Then 'there are table cells below

For Each nextCell In targetCell.Offset(1).Resize(targetCell.ListObject.ListRows.Count + targetCell.ListObject.Range.Row - targetCell.Row)

In each of them , there was a -1 which might have been creating the problem. I removed the -1.

Narayan
 
Hi
Thanks for the explanation
For the code: IfNot Intersect(Target, [DataEntryTable]) IsNothing,
Can i use a fixed Range eg D5:D7 instead of using tables?
 
You must log in or register to reply here.
Back
Top