CODEWITHSUNDEEP
excelvba
JoaMika
JoaMika

Reputation: 1827

Restrict Selected Cells to Range

I am using this code so that users can only select one cell at a time in a sheet.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Target.Range("A1").Select
    Application.CutCopyMode = False
End Sub

I am looking to apply this only to certain ListObject Ranges inside the sheet, e.g.

Range("table_1[Codes]")
Range("table_2[Names]")
Range("table_3[Cities]")

so then the user can freely select multiple cells outside those ListObject Ranges.

Upvotes: 1

Views: 363

Answers (1)

Pᴇʜ
Pᴇʜ

Reputation: 57683

Just use the Application.Intersect method to test if the Target is in another range.

If Not Intersect(Target, Me.Range("table_1[Codes]")) Is Nothing _
Or Not Intersect(Target, Me.Range("table_2[Names]")) Is Nothing _
Or Not Intersect(Target, Me.Range("table_3[Cities]")) Is Nothing Then
    Target.Range("A1").Select
    Application.CutCopyMode = False
End If

Alternatively to the Or you could also use Union:

If Not Intersect(Target, Union(Me.Range("table_1[Codes]"), Me.Range("table_2[Names]"), Me.Range("table_3[Cities]"))) Is Nothing Then
    Target.Range("A1").Select
    Application.CutCopyMode = False
End If

If you want it to be safe agains errors like one of the tables in the list does not exist you must use some error handling:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim RangeNames() As Variant
    RangeNames = Array("table_1[Codes]", "table_2[Names]", "table_3[Cities]", "this does not exist")

    Dim RangeName As Variant, TestRange As Range
    For Each RangeName In RangeNames
        Set TestRange = Nothing
        On Error Resume Next
        Set TestRange = Intersect(Target, Me.Range(RangeName))
        On Error GoTo 0

        If Not TestRange Is Nothing Then
            Target.Range("A1").Select
            Application.CutCopyMode = False
            Exit For
        End If
    Next RangeName
End Sub

If one of the named tables does not exist this code still works for the others.

Upvotes: 3

Related Questions