Rename tabs with same name in an Excel sheet

Question

I am trying to rename tabs in my large excel by using a cell value in each worksheet. The issue is, I would like to rename multiple tabs with the same name, which is not allowed. I am ok with adding a 1, then a 2 etc but am not sure how to do that.

For example if the cell value in 3 sheets is Ohio, then the tabs would be Ohio1, Ohio2, Ohio3.

The name of each sheet should be the value in A1, but I want to account for duplicate names.

The vba code to do it without accounting for the same name is:

Sub Worksheet_SelectionChange()
Dim ws As Worksheet

For Each ws In Sheets
ws.Activate
ActiveSheet.Name = Range("a1").Value

Next ws

End Sub

Answer 1

Sub Worksheet_SelectionChange()
Dim ws As Worksheet
Dim i As Integer

i = 1

On Error GoTo fixName

For Each ws In Me.Worksheets

ws.name = ws.Range("A1").Value


Next ws


Exit Sub
fixName:
ws.name = ws.Range("A1").Value & i
i = i + 1

End Sub

Answer 2

Sub RenameTabs()
    Dim ws As Worksheet, wsName$, wsCount%, dict   ' $ is short for " As String" and % for " As Integer"
    Set dict = CreateObject("Scripting.Dictionary")

    For Each ws In Sheets
        wsName = ws.Range("A1").Value
        wsCount = IIf(dict.Exists(wsName), dict(wsName) + 1, 1)
        dict(wsName) = wsCount

        If wsCount = 1 Then
            ws.Name = wsName
        Else
            If wsCount = 2 Then Sheets(wsName).Name = wsName & 1 ' optional to rename the previous Ohio sheet to Ohio1
            ws.Name = wsName & wsCount
        End If
    Next ws
End Sub