Automatically check for worksheet names and make adjustments

[smiley3141]

Hello, everyone. I am trying to check have VBA check to see if a worksheet name already exists before adding a worksheet. If it does, I want to make an Adjustment to the name and then check the new name (The adjustment adds " - 2" and then " - 3" and so on to the original name each time through the loop). This seemed pretty simple but I cannot make it work. If the original name is not one of the sheet names, it works fine, but it does not add a worksheet with the adjusted names even if they are not already one of the named sheets. Can someone help me? I am using Excel 2010.

My code is the following:

Sub AddNewWorksheet()
Dim NewName As String
Dim NumSheets As Long
Dim i As Long
Dim WorksheetsExists As Boolean

NumSheets = Sheets.Count

For i = 1 To NumSheets + 1

NewName = Range("MyTabName")


For Each Sht In ThisWorkbook.Worksheets
'Following line ignores case in comparison
If UCase(Sht.Name) = UCase(NewName) Then
WorksheetExists = True
Exit For
End If
Next Sht

If WorksheetExists = False Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = NewName
i = NumSheets + 1
Else
Range("TabNameAdj").Value = Range("TabNameAdj").Value + 1
End If

Next i
End Sub

Thanks for any help you can give me.

 

[Comfy]

I would do something like this:

'Can be used to check if named object exists
' i.e. If Contains(Sheets, "Sheet1") Then .....
Function Contains(objCollection As Object, strName As String) As Boolean
    Dim o As Object
    On Error Resume Next
    Set o = objCollection(strName)
    Contains = (Err.Number = 0)
End Function
Sub AddSheet()


Dim Exists As Boolean
Dim Name As String
Dim NewName As String
Dim i As Long


Exists = True
Name = "Sheet1"
NewName = Name
i = 1


Do While Exists = True
Exists = Contains(Sheets, NewName)
NewName = Name & "-" & i
i = i + 1
Loop


Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = NewName




End Sub

 

[smiley3141]

Thank you Comfy. That works well after one minor change is made. In the Do While Loop, the line "NewName = Name & "-" & i" must be placed above "Exists = Contains(Sheets, NewName)." Thanks for your help.

 

[Comfy]

No it doesn't.

If you move it above Exists = Contains(Sheets, NewName) you will not check to see if the first name exists.