Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Myrange As Range, KeepOut As Range
Dim ws As Worksheet
'Full sheet
'Set KeepOut = ActiveSheet.Cells
'Several Columns
'Set KeepOut = ActiveSheet.Range("B:D")
'Test Range
Set KeepOut = ActiveSheet.Range("A2:C5")
Set Myrange = Intersect(Target, KeepOut)
'Leave if the intersection ws untouched
If Myrange Is Nothing Then Exit Sub
'Stop select firing a second time
Application.EnableEvents = False
If KeepOut.Rows.Count = 65536 And KeepOut.Columns.Count = 256 Then
'Entire sheet is the KeepOut range. Eek!
'Bounce user to a dummy sheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets("KickMeTo")
On Error Goto 0
If ws Is Nothing Then
Set ws = ThisWorkbook.Sheets.Add
ws.Name = "KickMeTo"
End If
MsgBox "Houston we have a problem" & vbNewLine & _
"You cannot select any cell in " & vbNewLine & "'" & KeepOut.Parent.Name & "'" & vbNewLine & _
"So you have been directed to a different sheet"
ws.Activate
ElseIf KeepOut.Rows.Count = 65536 Then
'If all rows are contained in the "KeepOut" range then:
'Now we need to find a cell that is in a column to the right or left of this range
If KeepOut.Cells(1).Column > 1 Then
'If there is a valid column to the left of the range then select the cell in this column
Cells(KeepOut.Cells(1).Row, KeepOut.Cells(1).Column - 1).Select
Else
'Else select the cell in first column to the right of the range
Cells(KeepOut.Cells(1).Row, KeepOut.Cells(1).Column + 1).Select
End If
MsgBox "You cannot select " & KeepOut.Address(False, False) & vbNewLine & _
"You have been directed to the first free column in the protected range", vbCritical
ElseIf KeepOut.Rows.Count + KeepOut.Cells(1).Row - 1 = 65536 Then
'Select first cell in Column A before "KeepOut" Range
Cells(KeepOut.Cells(1).Row - 1, 1).Select
MsgBox "You cannot select " & KeepOut.Address(False, False) & vbNewLine & _
"You have been directed to the first free cell in Column A above the protected range", vbCritical
Else
'Select first cell in Column A beyond "KeepOut" Range
MsgBox "You cannot select " & KeepOut.Address(False, False) & vbNewLine & _
"You have been directed to the first free cell in Column A below the protected range", vbCritical
Cells(KeepOut.Rows.Count + KeepOut.Cells(1).Row, 1).Select
End If
Application.EnableEvents = True
End Sub
|