Auto increment by 1 when rename excel any tab if name exist

[Mohsin110]

Please suggest me a VBA code, when copy any tab and rename it if the names already exist, it should auto increment by 1 instead of giving a message (That name is already taken. Try a different name).
For example if the sheets already are available as SP001-1633, SP001-1633 (2), SP001-1633 (3), then I copy and paste any tab and try to rename as SP001-1633 it should auto increment as SP001-1633 (4).

 

[jkpieterse]

Something like this?

Option Explicit

Sub RenameASheet()
    Dim thisSheet As Worksheet
    Dim indexNum As Long
    Dim newName As String
    Dim leftOfName As String
    Set thisSheet = ActiveSheet
    newName = InputBox("Please provide the new name for this sheet", "Rename sheet " & thisSheet.Name, thisSheet.Name)
    If newName <> thisSheet.Name Then
        indexNum = GetIndexForSheetName(newName)
        If indexNum = 0 Then
            thisSheet.Name = newName
        Else
            leftOfName = Trim(CStr(Split(newName, "(")(0)))
            thisSheet.Name = leftOfName & " (" & indexNum & ")"
        End If
    End If
End Sub

Function GetIndexForSheetName(newName) As Long
    Dim sh As Worksheet
    Dim leftOfName As String
    Dim ct As Long
    leftOfName = Trim(CStr(Split(newName, "(")(0)))
    For Each sh In ThisWorkbook.Worksheets
        If LCase(sh.Name) Like LCase(leftOfName) & "*" Then
            ct = ct + 1
        End If
    Next
    GetIndexForSheetName = ct
End Function