Sheet naming

[Pat]

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

 

[Bob Phillips]

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]

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]

Apologizes Bob I incorrectly addressed you by another name.

 

[Bob Phillips]

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]

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]

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]

Eureka!

Thanks ever so much Bob.

Cheers
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)


changing problem for fail.