Vba code to rename a sheet or show an error

Question

I have a workbook with many sheets. I am webscraping with numbers, and then making each sheet have the number as the name. I want to display an error if the number has already been given to a sheet. I also want the user to be able to enter a new sheetname if so, but the program keeps popping up its own error message before I can do this.

The number is in cell D10 in the worksheet.

          For Each Sheet In ThisWorkbook.Sheets
            If Sheet.Name = Range("D10") Then
                MsgBox ("ERROR: This Acct No has already been formulated")
                NewName = InputBox("Please Rename:")
                ActiveSheet.Name = NewName
            ElseIf Sheet.Name <> Range("D10") Then
                ActiveSheet.Name = Range("D10")

            End If
            Next Sheet

I expect my own message to pop up, but Excel just pops its own error message.

The problem is the `ElseIf`. Think about it: as your code stands, it will attempt to create a new sheet for *every* sheet whose name is *not* `D10`'s value — cybernetic.nomad, Jun 21 '19 at 17:30
Will it? At first I was going to comment back that you were correct, but isn't the elseif saying that if I don't have a sheet already named this then to name it D10? — vba_user111, Jun 21 '19 at 17:33
No, the loop checks one sheet at a time. Say I have three sheets, named "1", "2" and "3" and the value in `D10` is "2". First pass Sheet "1" name <> "2", therefore it Excel attempts to name the sheet "2", but throws an error because sheet "2" already exists — cybernetic.nomad, Jun 21 '19 at 17:37

score 2 · Accepted Answer · answered Jun 21 '19 at 17:34

2

try this:

Dim MyDuplicate as boolean

MyDuplicate = False

For Each Sheet In ThisWorkbook.Sheets
    If Sheet.Name = Range("D10") Then
        MsgBox ("ERROR: This Acct No has already been formulated")
        NewName = InputBox("Please Rename:")
        ActiveSheet.Name = NewName
        MyDuplicate = True
        Exit for
    End If
Next Sheet

If MyDuplicate = False then ActiveSheet.Name = Range("D10")

BTW, I do recommend you avoid using ActiveSheet and assign the sheet to a variable instead.

answered Jun 21 '19 at 17:34

cybernetic.nomad

6,100
3
18
31

This worked! Thanks so much! I see the issue with the ElseIf now. Thanks again – vba_user111 Jun 21 '19 at 17:40
1

@DavidZemens Error will happen – JohnyL Jun 21 '19 at 18:13

score 1 · Answer 2 · answered Jun 21 '19 at 17:36

Option Explicit

Sub TestMe()

    Dim wks As Worksheet
    Worksheets.Add After:=ActiveSheet

    For Each wks In ThisWorkbook.Worksheets
        With wks
            If .Name = .Range("D10") Then
                MsgBox ("ERROR: This Acct No has already been formulated")
                .Name = InputBox("Please Rename:")
            ElseIf .Name <> .Range("D10") Then
                If Trim(.Range("D10")) = "" Then
                    .Range("D10") = Replace(Replace(Now, ":", "_"), "/", "_")
                    Application.Wait Now + #12:00:02 AM#
                End If
                .Name = .Range("D10").Value
            End If
        End With
    Next wks

End Sub

This is some idea how to do it, avoiding the Activate and Select, as per the How to avoid using Select in Excel VBA (Ironically, I have left Worksheets.Add After:=ActiveSheet)

The part .Range("D10") = Replace(Replace(Now, ":", "_"), "/", "_") writes the current date and time, making sure it is always a unique one, by waiting 2 seconds on the next line - Application.Wait Now + #12:00:02 AM#

David Zemens · Answer 3 · 2019-06-21T18:03:45.393

Rather than looping every sheet to check for duplicates, create a function that returns a boolean. This function will have an error if the sheet doesn't exist, and no error if the sheet does exist. We check for that error, and return True if sheet exists, False otherwise.

Option Explicit

Private Function SheetExists(wsName As String, Optional wb As Workbook = Nothing) As Boolean
Dim ws As Worksheet
On Error Resume Next
If wb Is Nothing Then
    Set ws = Worksheets(wsName)
Else
    Set ws = wb.Worksheets(wsName)
End If
SheetExists = (Err.Number = 0)
End Function

And then your code could be replaced with the following, which will keep calling on the InputBox as many times as necessary in order to prevent the user from inputting another invalid/duplicate entry. For this, I've combined the MsgBox and InputBox text, seems unnecessary to throw two prompts at the user when we can use the InputBox to both inform and ask for new input.

Dim ws as Worksheet
Dim newName as String
Set ws = ActiveSheet   ' would be better to avoid this, but OK.
newName = Range("D10").Value
While SheetExists(newName, ws.Parent)
    newName = InputBox("ERROR: This Acct No has already been formulated!" & vbCrLf & vbCrLf & _
                    newName & " already exists! Enter new name:")
Wend
ws.Name = newName

Vba code to rename a sheet or show an error

3 Answers3