VBA Loop requiring user to enter a new sheet name

Viewed 88

I am currently creating a new sheet and having the user name it with a unique sheet name. I have a loop that checks once and prompts the user to enter a new sheet name if it is wrong the first time, but I don't know how to restart the loop once this happens.

Dim myValue As Variant
    myValue = InputBox("Enter New Sheet Name")
    
    Dim exists As Boolean
    exists = True
While exists = True
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = myValue Then
            exists = True
            myValue = InputBox("You entered an existing sheet name. Please enter a unique sheet name")
        Else
        exists = False
        End If
        Next i
    i = 1
Wend

Sheets("NewSheet").Name = myValue

End Sub

Thank you!

6 Answers

Using the worksheet renaming error handling method, you get the fastest and shortest way to determine the uniqueness and acceptability of a name, since there are character composition and name length restrictions. Try this code:

Sub test1()
    Dim newWS As Worksheet, myValue As String, prompt As String
    prompt = "Enter New Sheet Name"     'start prompt
    
    Set newWS = ThisWorkbook.Worksheets.Add
    
    Do
        myValue = InputBox(prompt)
        On Error Resume Next            'disable the system response to errors
        newWS.Name = myValue            'trying to rename
        If Err.Number = 0 Then Exit Do  'check the Err object; if no error then exit loop
        On Error GoTo 0                 'enable the system response to errors
        prompt = "You entered an existing or unacceptable sheet name." & _
                 vbLf & "Please enter a unique sheet name"  'next try prompt
    Loop
End Sub

Try this:

Option Explicit

Sub CreateNewWorksheet()
    Dim newName As String
    newName = InputBox("Enter the new sheet name:")
    
    Dim waitingForUniqueName As Boolean
    waitingForUniqueName = True
    Do While waitingForUniqueName
        Dim ws As Worksheet
        For Each ws In ThisWorkbook.Sheets
            If ws.Name = newName Then
                newName = InputBox("You entered an existing sheet name. " & _
                                   "Please enter a unique sheet name.")
                waitingForUniqueName = True
                Exit For
            Else
                waitingForUniqueName = False
            End If
        Next ws
    Loop
    
    Dim newWS As Worksheet
    Set newWS = ThisWorkbook.Sheets.Add
    newWS.Name = newName
End Sub

This will do what you are looking for using recursion. It just recalls the sub passing a value to an optional parameter until an unused name is chosen.

Sub test()

recurse_name

End Sub


Sub recurse_name(Optional ByVal myValue As String)
    Dim i As Long

    If myValue = "" Then
        myValue = InputBox("Enter New Sheet Name")
    End If
    
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = myValue Then
            myValue = InputBox("You entered an existing sheet name. Please enter a unique sheet name")
            recurse_name myValue
            Exit Sub
        End If
    Next i
    
    Sheets("NewSheet").Name = myValue
End Sub

This code uses a separate function, which could be used elsewhere, to check if a sheet with the entered name already exists.

Option Explicit

Sub RenameSheet()
Dim myValue As String
Dim exists As Boolean

    myValue = InputBox("Enter New Sheet Name")

    Do
        exists = SheetExists(myValue)
        If exists Then
            myValue = InputBox("You entered an existing sheet name. Please enter a unique sheet name")
        End If
    Loop Until Not exists

    Sheets("NewSheet").Name = myValue

End Sub

Function SheetExists(strName As String, Optional wb As Workbook) As Boolean
Dim ws As Worksheet
    
    If wb Is Nothing Then
        Set wb = ActiveWorkbook
    End If

    For Each ws In wb.Worksheets
        If LCase(ws.Name) = LCase(strName) Then
            SheetExists = True
            Exit For
        End If
    Next ws
    
End Function

    

Add a New Worksheet

  • You have more options with the flexible Application.InputBox e.g. you can easily distinguish between "" and Cancel (False).
  • By previously not adding the worksheet, you are allowing to cancel the operation (without the need to delete the worksheet).
Option Explicit

Sub AddNewWorksheet()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet
    Dim wsName As Variant
    
    Do
        wsName = Application.InputBox( _
            "Enter New Sheet Name", "Sheet Name", "Sheet1", , , , 1)
        If wsName = False Then
            MsgBox "User canceled.", vbCritical
            Exit Do
        ElseIf IsSheetNameTaken(wb, wsName) Then
            MsgBox "A sheet named '" & wsName & "' already exists. " _
                 & "Please enter a unique sheet name.", vbExclamation
        ElseIf Not IsValidSheetName(wsName) Then
            MsgBox "The name '" & wsName & "' is invalid.", vbExclamation
        Else
            Set ws = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
            ws.Name = wsName
            MsgBox "Added the '" & wsName & "' worksheet.", vbInformation
            Exit Do
        End If
    Loop
    
    If ws Is Nothing Then Exit Sub ' worksheet not added
    
    ' Continue with the code using the worksheet variable 'ws'.

End Sub


Function IsSheetNameTaken( _
    ByVal wb As Workbook, _
    ByVal SheetName As String) _
As Boolean
    On Error Resume Next
    Dim sh As Object: Set sh = wb.Sheets(SheetName)
    On Error GoTo 0
    IsSheetNameTaken = Not sh Is Nothing
End Function

Function IsValidSheetName( _
    ByVal SheetName As String) _
As Boolean
    If Len(SheetName) = 0 Then Exit Function
    If Len(SheetName) > 31 Then Exit Function
    Const iCharsList As String = ":,\,/,?,*,[,] "
    Dim iChars() As String: iChars = Split(iCharsList, ",")
    Dim n As Long
    For n = 0 To UBound(iChars)
        If InStr(1, SheetName, iChars(n)) > 0 Then
            Exit Function
        End If
    Next n
    IsValidSheetName = True
End Function

Following code makes array of sheet names and with Instr function checks if the sheeet with the given name already exists. If so, it will again prompt to enter a new name with error message. New sheet will not be added until user enters a new name. User will have option to exit the sub with empty inputbox without adding the new sheet.

Option Explicit

Sub AddSheetWithGivenName()
Dim SheetNamesStr As String, IBPrompt As String, NewSheetName As String

If IsError(Evaluate("SheetNames")) Then
    ThisWorkbook.Names.Add Name:="SheetNames", RefersToR1C1:= _
    "=MID(GET.WORKBOOK(1),FIND(""]"",GET.WORKBOOK(1),1)+1,LEN(GET.WORKBOOK(1)))"
End If
SheetNamesStr = "," & Join(Evaluate("SheetNames"), ",") & ","

IBPrompt = "Enter New Sheet Name"

InputSheetName:

NewSheetName = InputBox(IBPrompt, "New Sheet Name")

If NewSheetName = "" Then
    Exit Sub
Else
    If InStr(1, SheetNamesStr, "," & NewSheetName & ",", vbBinaryCompare) Then
    IBPrompt = "Sheet name already exists !!!" & vbCrLf & vbCrLf & _
                "Please enter new sheet name"
    GoTo InputSheetName
    End If
End If

With ThisWorkbook.Worksheets.Add
    .Name = NewSheetName
End With

End Sub

enter image description here

Related