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:

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,212,933
Messages
6,110,752
Members
448,295
Latest member
Uzair Tahir Khan

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top