Alteration to sheet naming code

[Brooksy1]

Hi all,

I currently use the below piece of code to rename sheets based on a cell value. I wonder if anyone can help me alter the code so that a replication of the same name is updated with a number. For example if there are two cells (that both alter sheet names) with Joe Bloggs written in them currently one of the sheet names would change to Joe Bloggs while the other would not be renamed as you cannot have two identically named sheets.

What i would like is to update this code so the first sheet would rename to Joe Bloggs and the second sheet would be renamed to Joe Bloggs 2. if there was a third then it would rename the third sheet to Joe Bloggs 3. There is no need for this to change the name within the cell only the sheet name that the cell affects.

Hopefully this makes sense but please let me know if you need further info.

Many thanks

Tom

Private Sub Worksheet_Calculate()
With Range("C9")
If Len(.Value) = 0 Or Len(.Value) > 31 Then Exit Sub

Dim IllegalCharacter(1 To 7) As String, i As Integer
IllegalCharacter(1) = "/"
IllegalCharacter(2) = "\"
IllegalCharacter(3) = "["
IllegalCharacter(4) = "]"
IllegalCharacter(5) = "*"
IllegalCharacter(6) = "?"
IllegalCharacter(7) = ":"
For i = 1 To 7
If InStr(.Text, (IllegalCharacter(i))) > 0 Then
MsgBox "The formula in cell A1 returns a value containing a character that violates sheet naming rules." & vbCrLf & _
"Recalculate the formula without the ''" & IllegalCharacter(i) & "'' character.", _
48, "Not a possible sheet name !!"
Exit Sub
End If
Next i

Dim strSheetName As String, wks As Worksheet, bln As Boolean
strSheetName = (.Text)
On Error Resume Next
Set wks = ThisWorkbook.Worksheets(strSheetName)
On Error Resume Next
If Not wks Is Nothing Then
bln = True
Else
bln = False
Err.Clear
End If

If bln = False Then
Sheet26.Name = strSheetName
End If

End With
End Sub

____________________________________________________________

Moved by Moderator.


.