Private Sub cmdAdd_Click()
Sheets("Sheet1").Select
Sheets.Add
End Sub

The above code will create a copy of Sheet1 by increments of 1.
I want to modify the code and name the sheet based on a value in A1. For
example;

A1 = Joe1
when the code is run it names the sheet Joe2
run the code again it names it Joe3
etc

Change A1 to Mary1
when the code is run it names the sheet Mary2
run the code again it names it Mary3
etc

Change A1 to ()1
etc

If Joe1 is in A1 again
when the code is run it names the sheet Joe4

Anyone know if this is possible?

Thanks
Pat

Pat,

Try this 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
.Value = 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
...
Private Sub cmdAdd_Click()
Sheets("Sheet1").Select
Sheets.Add
End Sub

The above code will create a copy of Sheet1 by increments of 1.
I want to modify the code and name the sheet based on a value in A1. For
example;

A1 = Joe1
when the code is run it names the sheet Joe2
run the code again it names it Joe3
etc

Change A1 to Mary1
when the code is run it names the sheet Mary2
run the code again it names it Mary3
etc

Change A1 to ()1
etc

If Joe1 is in A1 again
when the code is run it names the sheet Joe4

Anyone know if this is possible?

Thanks
Pat

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

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

Try this 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
.Value = 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
...
Private Sub cmdAdd_Click()
Sheets("Sheet1").Select
Sheets.Add
End Sub

The above code will create a copy of Sheet1 by increments of 1.
I want to modify the code and name the sheet based on a value in A1. For
example;

A1 = Joe1
when the code is run it names the sheet Joe2
run the code again it names it Joe3
etc

Change A1 to Mary1
when the code is run it names the sheet Mary2
run the code again it names it Mary3
etc

Change A1 to ()1
etc

If Joe1 is in A1 again
when the code is run it names the sheet Joe4

Anyone know if this is possible?

Thanks
Pat

Apologizes Bob I incorrectly addressed you by another name.

"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

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

Try this 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
.Value = 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
...
Private Sub cmdAdd_Click()
Sheets("Sheet1").Select
Sheets.Add
End Sub

The above code will create a copy of Sheet1 by increments of 1.
I want to modify the code and name the sheet based on a value in A1.
For
example;

A1 = Joe1
when the code is run it names the sheet Joe2
run the code again it names it Joe3
etc

Change A1 to Mary1
when the code is run it names the sheet Mary2
run the code again it names it Mary3
etc

Change A1 to ()1
etc

If Joe1 is in A1 again
when the code is run it names the sheet Joe4

Anyone know if this is possible?

Thanks
Pat

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

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

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

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