Try this then, I didn't allow for you running the macro more than once, is that what you meant by.
...I tried it in your sheet and in mine, it does the first one then gives me an error....
Change the variable strRange to suit your reference cell
Option Explicit
Sub RenameSheets()
Dim i As Integer, n As Integer, ctr As Integer
Dim LastIndex As Long, NextIndex As Long
Dim strNewName As String, strOldName As String
Dim strRange As String
strRange = "A1"
For i = 1 To Worksheets.Count
If Worksheets(i).Range(strRange) <> "" Then
strNewName = Format(Worksheets(i).Range(strRange), "dd-mmm-yyyy")
Else
strNewName = "Default"
End If
If InStr(1, Worksheets(i).Name, strNewName) = 0 Then
For n = 1 To Sheets.Count
If InStr(1, Worksheets(n).Name, strNewName) Then
strOldName = Worksheets(n).Name
ctr = ctr + 1
If InStr(1, strOldName, "(") Then
LastIndex = Mid(strOldName, InStr(1, strOldName, "(") + 1, _
Len(strOldName) - 1 - InStr(1, strOldName, "("))
If LastIndex > NextIndex Then NextIndex = LastIndex
End If
End If
Next
If NextIndex >= ctr Then ctr = NextIndex + 1
If ctr > 0 Then strNewName = strNewName & "(" & ctr & ")"
Worksheets(i).Name = strNewName
ctr = 0
NextIndex = 0
End If
Next
End Sub
I have left a macro in this attachment that will reset the sheet names to "Sheet1", "Sheet2", "Sheet3", etc this should only be used after running the main macro.
If this doesn't work post a sample workbook that contains the conditions met in your workbook.
Bookmarks