Need Private Sub Worksheet_Change(ByVal Target As Range) to see multiple tables

Barto028579

New Member
Joined
Dec 24, 2018
Messages
2
Below is code that works for a single table with one column that has dropdowns that influence another column's drop down lists. The second columns dropdown lists are hosted in a separate tab. I would like to have two tables with the same abilities: Table_Tc and Table_Tc2. How do I add the functions for the second table into the code below?

Code:
Private Sub Worksheet_Change(ByVal Target As Range)


    If Intersect(Target, Range("Table_Tc[Flow Type]")) Is Nothing Then
        Exit Sub
    ElseIf Target Is Nothing Then
        Exit Sub
    ElseIf Target.Value = "" Or IsEmpty(Target) Then
        Exit Sub
    ElseIf Target.Cells.Count = 1 And Not Intersect(Target, Range("Table_Tc[Flow Type]")) Is Nothing Then
        Dim ListRange As String
        Dim cell As Range
        Set cell = Cells(Target.Row, Range("=Table_Tc[[#Headers],[Surface Description]]").Column)
        
        Application.EnableEvents = False
        Call UnprotectActiveSheet_NoUserInput
        
        Select Case Target.Value
        Case "Sheet Flow": ListRange = "=INDIRECT(""InputListTable_ManningRoughnessCoefficients_OverlandSheetFlow[Surface Description]"")"
        Case "Shallow Concentrated": ListRange = "=INDIRECT(""InputListTable_InterceptCoefficientsForVelocityVSSlopeRelationship[Land Cover/flow regime]"")"
        Case "Closed Conduits": ListRange = "=INDIRECT(""InputListTable_ManningClosedConduits[Land Cover/flow regime]"")"
        Case "Open Channel": ListRange = "=INDIRECT(""InputListTable_ManningOpenChannels[Land Cover/flow regime]"")"
        Case Else: GoTo EarlyExit
        End Select
        
        With cell.Validation
            .Delete
            .Add Type:=xlValidateList, _
                    AlertStyle:=xlValidAlertStop, _
                    Operator:=xlBetween, _
                    Formula1:=ListRange
            .IgnoreBlank = False
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
        cell.Value = ""
    
EarlyExit:
        Call ProtectActiveSheet_NoUserInput
        Application.EnableEvents = True
    End If
    Calculate
End Sub
 
Last edited by a moderator:

Zack Barresse

MrExcel MVP
Joined
Dec 9, 2003
Messages
10,724
You could use something like this to test for the two tables and use a common variable...

Code:
    Dim Table As ListObject
    Dim MatchedTable As Range
    
    On Error Resume Next
    Set MatchedTable = Intersect(Target, Me.ListObjects("Table_Tc").ListColumns("Flow Type").DataBodyRange)
    If MatchedTable Is Nothing Then
        Set MatchedTable = Intersect(Target, Me.ListObjects("Table_Tc2").ListColumns("Flow Type").DataBodyRange)
    End If
    If Not MatchedTable Is Nothing Then
        Set Table = MatchedTable.ListObject
        ' your code here, just reference 'Table' as your ListObject
        '...
    End If
 

Barto028579

New Member
Joined
Dec 24, 2018
Messages
2
Thanks Zack for replying.
I ended up getting it to work with this:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("Table_Tc[Flow Type]")) Is Nothing And Intersect(Target, Range("Table_Tc2[Flow Type]")) Is Nothing Then
        Exit Sub
    ElseIf Target Is Nothing Or Target.Cells.Count > 1 Then
        Exit Sub
    ElseIf Target.Value = "" Or IsEmpty(Target) Then
        Exit Sub
    ElseIf Target.Cells.Count = 1 And (Not Intersect(Target, Range("Table_Tc[Flow Type]")) Is Nothing Or _
                                       Not Intersect(Target, Range("Table_Tc2[Flow Type]")) Is Nothing) Then
        Dim ListRange As String
        Dim cell As Range
        
        If Not Intersect(Target, Range("Table_Tc[Flow Type]")) Is Nothing Then
            Set cell = Cells(Target.Row, Range("=Table_Tc[[#Headers],[Surface Description]]").Column)
        ElseIf Not Intersect(Target, Range("Table_Tc2[Flow Type]")) Is Nothing Then
            Set cell = Cells(Target.Row, Range("=Table_Tc2[[#Headers],[Surface Description]]").Column)
        Else
 

Forum statistics

Threads
1,085,724
Messages
5,385,509
Members
401,957
Latest member
Socksnpants

Some videos you may like

This Week's Hot Topics

Top