Eureka!

Thanks ever so much Bob.

Cheers
Pat

"Bob Phillips" wrote in message
...
Pat,

What a dodo (me!) :-)

Sub NameSheet()
Dim fExists As Boolean
Dim sName As String
Dim sh As Worksheet

Set sh = ActiveSheet
With sh.Range("A1")
If IsNumeric(Right(.Value, 1)) Then
sName = .Value
Do
sName = Left(sName, Len(sName) - 1) & _
Right(sName, 1) + 1
fExists = SheetExists(sName)
Loop Until Not fExists
Worksheets.Add.Name = sName
sh.Activate
End If
End With

End Sub


'-----------------------------------------------------------------
Function SheetExists(sh As String, _
Optional wb As Workbook) As Boolean
'-----------------------------------------------------------------
Dim oWs As Worksheet
If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
SheetExists = CBool(Not wb.Worksheets(sh) Is Nothing)
On Error GoTo 0
End Function




--

HTH

RP
(remove nothere from the email address if mailing direct)


"Pat" wrote in message
...
Hello again Bob,

.Value = sName
Although removing the above has aloud the origional value to be
reinstated,
but if the code is run again the same problem (as I mentioned earlier)
with
the continues looping keeps occurs.

Pat

"Bob Phillips" wrote in message
...
Pat,

The problem with that is that it will cycle through many sheets to see
if
they exist, but I did allow for this, so all you need to do is remove
the
line

.Value = sName

which saves it back.

Amended code.

Sub NameSheet()
Dim fExists As Boolean
Dim sName As String
Dim sh As Worksheet

Set sh = ActiveSheet
With sh.Range("A1")
If IsNumeric(Right(.Value, 1)) Then
Do
sName = Left(.Value, Len(.Value) - 1) & _
Right(.Value, 1) + 1
fExists = SheetExists(sName)
Loop Until Not fExists
Worksheets.Add.Name = sName sh.Activate
End If
End With

End Sub


'-----------------------------------------------------------------
Function SheetExists(sh As String, _
Optional wb As Workbook) As Boolean
'-----------------------------------------------------------------
Dim oWs As Worksheet
If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
SheetExists = CBool(Not wb.Worksheets(sh) Is Nothing)
On Error GoTo 0
End Function


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Pat" wrote in message
...
That's pretty good Phil.
The only change (if possible) I would need is to prevent ()1
changing
to
()2
in the cell, this increments to reflect the sheet change. The
problem
I
can
see happening is that after trying to locate the last sheet number
for
a
particular person the wrong number is entered and the code will
fail.
I
have tried this out and the code seemed to go into a loop which I
then
had
to use ctrl+alt+del to get out of.

Regards
Pat