Vba code to rename a sheet or show an error - excel

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.

Answer 1

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.

Answer 2

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#

Answer 3

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