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("D7:D106")
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
:) :) :) :) :

--
Celtic_Avenge
-----------------------------------------------------------------------
Celtic_Avenger's Profile: http://www.excelforum.com/member.php...fo&userid=1410
View this thread: http://www.excelforum.com/showthread.php?threadid=26125

Better still, in the SelectionChange Event Routine, add:

Dim StatusMsg(1 to 4) as string
StatusMsg(1)="Please Enter The Workers Surname"
(etc. for StatusMsg(2) to (4))

Then later ......

If Not Isect Is Nothing then Application.Statusbar = StatusMsg(i)
Exit For

(etc.)

AlexJ

"Celtic_Avenger" wrote in
message ...

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("D7:D106")
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 Entries
Here Will Appear On Dispatch Sheet."
End Select
End Sub

This then worked an absolute treat.

Thanks Very Much For Your Help.

Celtic_Avenger
:) :) :) :) :)


--
Celtic_Avenger
------------------------------------------------------------------------
Celtic_Avenger's Profile:
http://www.excelforum.com/member.php...o&userid=14101
View this thread: http://www.excelforum.com/showthread...hreadid=261256