Renaming Sheets from cells with a loop

Question

The code below is what i use to rename a bunch of sheets within a workbook. it works perfectly. It renames the sheet based off of a cell in that sheet. but now i have two sheets trying to use the same name. So i want to keep the same code but add a loop so if that happens, it will add a "2" to the second sheet. Ie cell contains "John Doe". Sheet will rename to "John Doe" and the next sheet that tries to use it will rename "John Doe 2"

Thank you

Sub RenameLaborLog()
    Dim rs As Worksheet
    For Each rs In Sheets
        rs.Name = Split(rs.Range("H4").Value, " ")(1) & ", " & Left(Split(rs.Range("H4").Value)(0), 1) & "."

    Next rs
End Sub

Answer 1

just to show another way you can reach your goal

Sub RenameLaborLog()
  Dim rs As Worksheet, i As Long, str As String
  On Error Resume Next
  For Each rs In Sheets
    str = Split(rs.Range("H4").Value, " ")(1) & ", " & Left(Split(rs.Range("H4").Value)(0), 1) & "."
    rs.Name = str
    i = 1
    While Err.Number <> 0 And i < 20
      Err.Clear: i = i + 1
      rs.Name = str & i
    Wend
    If Err.Number <> 0 Then MsgBox "Error: " & rs.Name & " cant be set to any " & str: Exit Sub
  Next rs
End Sub

it tries to set the name (and if that is not working it sets the name & 2 - 19 (if that doesnt work, it pops up a message box and exits the sub)