C
Celtic_Avenger
Thanks Alex
I just tweaked what you wrote to:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ShtRng(1 To 4) As Range
Dim Isect As Range
Dim i As Long
Set ShtRng(1) = Me.Range("B7:B106")
Set ShtRng(2) = Me.Range("C7:C106")
Set ShtRng(3) = Me.Range("D7106")
Set ShtRng(4) = Me.Range("E7:E106")
For i = 1 To 4
Set Isect = Intersect(Target, ShtRng(i))
If Not Isect Is Nothing Then
Call DoSomething(i)
Exit For
End If
Next i
Erase ShtRng
End Sub
Sub DoSomething(Idx As Long)
Select Case Idx
Case Is = 1
Application.StatusBar = "Please Enter The Workers Surname"
Case Is = 2
Application.StatusBar = "Please Enter The Workers Forename"
Case Is = 3
Application.StatusBar = "Does The Worker Have Their Own Transport?
*Presumed As No If Left Blank."
Case Is = 4
Application.StatusBar = "Enter Any Required Comments. *Any Entrie
Here Will Appear On Dispatch Sheet."
End Select
End Sub
This then worked an absolute treat.
Thanks Very Much For Your Help.
Celtic_Avenger
:
I just tweaked what you wrote to:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ShtRng(1 To 4) As Range
Dim Isect As Range
Dim i As Long
Set ShtRng(1) = Me.Range("B7:B106")
Set ShtRng(2) = Me.Range("C7:C106")
Set ShtRng(3) = Me.Range("D7106")
Set ShtRng(4) = Me.Range("E7:E106")
For i = 1 To 4
Set Isect = Intersect(Target, ShtRng(i))
If Not Isect Is Nothing Then
Call DoSomething(i)
Exit For
End If
Next i
Erase ShtRng
End Sub
Sub DoSomething(Idx As Long)
Select Case Idx
Case Is = 1
Application.StatusBar = "Please Enter The Workers Surname"
Case Is = 2
Application.StatusBar = "Please Enter The Workers Forename"
Case Is = 3
Application.StatusBar = "Does The Worker Have Their Own Transport?
*Presumed As No If Left Blank."
Case Is = 4
Application.StatusBar = "Enter Any Required Comments. *Any Entrie
Here Will Appear On Dispatch Sheet."
End Select
End Sub
This then worked an absolute treat.
Thanks Very Much For Your Help.
Celtic_Avenger
: