Update to Macro - renaming worksheets according to text string in cell

[Mtyler]

Hi all

I've culled the following macro from a number of other sources to rename a sheet according to the text in cell C8 on that sheet

Sub Macro1()
z = Sheets.Count
For x = 1 To z
a = Sheets(x).Range("C8").Value
Sheets(x).Name = Left(a, 25)
Next
End Sub​

It works great. However, some of the data would lead to sheets being named identically, which throws out the macro. How can I update this macro so that it renames the second sheet with a (2) after the name?

In other words, gives me sheets called ABC Ltd and ABC Ltd (2) if two sheets have ABC Ltd in cell C8?

Thanks

Matt

 

[GTO]

Not well tested, but:

Option Explicit
    
Sub exa()
Dim wks As Worksheet
Dim i As Long
Dim strNewName As String
    i = 1
    For Each wks In ThisWorkbook.Worksheets
        strNewName = Left(wks.Cells(8, 3).Value, 25)
        Do While ShExists(strNewName)
            i = i + 1
            strNewName = Left(strNewName, 25) & Chr(32) & "(" & i & ")"
        Loop
        wks.Name = strNewName
    Next
End Sub
    
Function ShExists(ShName As String, _
                  Optional wb As Workbook, _
                  Optional CheckCase As Boolean = False) As Boolean
    
    If wb Is Nothing Then
        Set wb = ThisWorkbook
    End If
    
    If CheckCase Then
        On Error Resume Next
        ShExists = CBool(wb.Worksheets(ShName).Name = ShName)
        On Error GoTo 0
    Else
        On Error Resume Next
        ShExists = CBool(UCase(wb.Worksheets(ShName).Name) = UCase(ShName))
        On Error GoTo 0
    End If
End Function

Hope thta helps,

Mark

 

[GTO]

[bleep]!

Stick the i=1 right below the For...Each

 

[Mtyler]

Thanks for reply GTO - appears to give me a number behind most sheet names, rather than just those where the sheet name is duplicated. Any thoughts?

Thanks

 

[GTO]

Hi Matt,

Sorry, you are right; the code I posted is far less than stellar. I've stared at this a couple of times, but brain-dead for some reason. I'll look tonight to see if you received some help.

Mark