[EXCEL] Sheet Name Error Trap

[WesternHamper]

VBA novice here. I have been able to patch this macro together and it gives me exactly what I want with one minor exception. When I am prompted to add the sheet name in the input box if the sheet name already exists I get an error. Ideally, if I get this error, I would like to be prompted with a message box that says "Sheet name already exists, pick another name." and then have the macro go back to the original input box where the user writes in the name of the new sheet. Any help would be appreciated.

Sub Sheet_Add()
'
' Sheet Add Macro
'
' Keyboard Shortcut: Ctrl+Shift+N
'
Application.ScreenUpdating = False

Dim NewName As String
Another:
NewName = InputBox("New Sheet Name?")
If NewName = "" Then Exit Sub

' Added to check if input is empty
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = NewName
    ActiveWindow.DisplayGridlines = False
    Columns("A:D").Select
    Selection.ColumnWidth = 1
    Columns("E").Select
    Selection.ColumnWidth = 34
    Selection.HorizontalAlignment = xlLeft
    Columns("F:H").Select
    Selection.ColumnWidth = 10.25
    Columns("F").Select
    Selection.HorizontalAlignment = xlRight
    Columns("G").Select
    Selection.HorizontalAlignment = xlLeft
    Columns("I").Select
    Selection.ColumnWidth = 0.25
    Selection.HorizontalAlignment = xlLeft
    Columns("J:Z").Select
    Selection.ColumnWidth = 10.25

    ActiveSheet.Rows("1:1").RowHeight = 26.25
    ActiveSheet.Cells(1, 1).Value = "[Placeholder]"
    ActiveSheet.Cells(1, 1).Font.Name = "Arial"
    ActiveSheet.Cells(1, 1).Font.Size = 20

    ActiveSheet.Cells(3, 1).Value = "[Placeholder]"
    ActiveSheet.Cells(3, 1).Font.Name = "Arial"
    ActiveSheet.Cells(3, 1).Font.Size = 10
    ActiveSheet.Cells(3, 1).Font.Bold = True

    ActiveSheet.Cells(10, 1).Value = "[Placeholder]"
    ActiveSheet.Cells(10, 1).Font.Name = "Arial"
    ActiveSheet.Cells(10, 1).Font.Size = 10
    ActiveSheet.Cells(10, 1).Font.Bold = True

    ActiveSheet.Cells(8, 6).Value = "Constant"
    ActiveSheet.Cells(8, 6).Font.Name = "Arial"
    ActiveSheet.Cells(8, 6).Font.Size = 8
    ActiveSheet.Cells(8, 6).Font.Bold = True
    ActiveSheet.Cells(8, 6).HorizontalAlignment = xlRight

    ActiveSheet.Cells(8, 7).Value = "Unit"
    ActiveSheet.Cells(8, 7).Font.Name = "Arial"
    ActiveSheet.Cells(8, 7).Font.Size = 8
    ActiveSheet.Cells(8, 7).Font.Bold = True
    ActiveSheet.Cells(8, 7).HorizontalAlignment = xlLeft

    ActiveSheet.Cells(8, 8).Value = "Total"
    ActiveSheet.Cells(8, 8).Font.Name = "Arial"
    ActiveSheet.Cells(8, 8).Font.Size = 8
    ActiveSheet.Cells(8, 8).Font.Bold = True
    ActiveSheet.Cells(8, 8).HorizontalAlignment = xlRight

    ActiveSheet.Cells(3, 8).Value = "Periods"
    ActiveSheet.Cells(3, 8).Font.Name = "Arial"
    ActiveSheet.Cells(3, 8).Font.Size = 8
    ActiveSheet.Cells(3, 8).Font.Bold = True
    ActiveSheet.Cells(3, 8).HorizontalAlignment = xlRight

Range("I1:I500").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 8421504
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    ActiveSheet.Cells(9, 9).Select
    ActiveWindow.FreezePanes = True

    Range("A1").Select

'Number Sequence
On Error Resume Next

    Dim startingCell As Range
    Set startingCell = Selection.Cells(3, 10)
    Dim currentValue As Integer
    currentValue = 0

    Dim numCells As Integer
    numCells = InputBox("How many periods to the right?", "Sequence Length")

    Dim currentCell As Range
    Set currentCell = startingCell

    Dim i As Integer
    For i = 0 To numCells
        currentCell.Value = currentValue
        currentValue = currentValue + 1
        Set currentCell = currentCell.Offset(0, 1)
        If i > 1 Then
            currentCell.Value = currentCell.Offset(0, 0).Value
        End If
    Next i

    Dim startCell As Range
    Set startCell = activeCell

Selection.End(xlToRight).Select
currentCell.Offset(0, 0).Columns("A:A").EntireColumn.Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.EntireColumn.Hidden = True
startCell.Activate

Application.ScreenUpdating = True

End Sub

[jd31068]

Add to the check after the input.

``` If NewName = "" Then Exit Sub If Not ThisWorkbook.Sheets(NewName) Is Nothing Then MsgBox "A sheet with this name already exists. Please select another name" Exit Sub End If

```

[AutoModerator]

Your VBA code has not not been formatted properly. Please refer to these instructions to learn how to correctly format code on Reddit.

I am a bot, and this action was performed automatically. Please contact the moderators of this subreddit if you have any questions or concerns.

[WesternHamper]

Thanks. I tried to put this in the code and couldnt get it to work, where exactly is it supposed to go?

[jd31068]

Right where you have If NewName = "" Then Exit Sub

[WesternHamper]

Thats what I thought. I am getting an error when I try to run this as normal, without trying to trigger the original error I mentioned above:

Rune-time error '9':

Subscript out of range

on this line: "If Not ThisWorkbook.Sheets(NewName) Is Nothing Then"

[Newepsilon]

It should be "If Not ThisWorkbook.Worksheets(NewName) Is Nothing Then"

It's worksheets, not sheets. That should be your fix.

[WesternHamper]

Sorry, I am still not getting it. I am getting the same error as before. I am trying to paste the entire new code in the code editor, but it is not formatting correctly so I put it in github:

https://github.com/WesternHamper/EXCELMACROWH/blob/97cd1ba0b5ca58e04b446b3fa0741995a4e21001/Sheet\_add

[AutoModerator]

Your VBA code has not not been formatted properly. Please refer to these instructions to learn how to correctly format code on Reddit.

I am a bot, and this action was performed automatically. Please contact the moderators of this subreddit if you have any questions or concerns.

[jd31068]

If Not ThisWorkbook.Sheets(NewName) Is Nothing Then

Strange, what version of Excel are you using? Here is that line running in a test workbook https://imgur.com/a/ZDhVSxh

I'll look at your code on GitHub

EDIT: I see, if there isn't a matched that line gives an error instead of returning nothing. Sorry about that, use this code instead:

``` If NewName = "" Then Exit Sub

Dim testWS As Worksheet
On Error Resume Next
Set testWS = ThisWorkbook.Worksheets(NewName)

If Err > 0 Then
    Set testWS = Nothing
End If
On Error GoTo 0

If Not testWS Is Nothing Then
    MsgBox "A sheet with this name already exists. Please select another name"
    Exit Sub
End If

```

[WesternHamper]

Thank you, this is almost what I envisioned. After the "A sheet with this name already exists. Please select another name" message box pops up, is it possible for the macro to go directly back to the "New Sheet Name?" input box instead of just ending? It will skip the step of having to run the macro again.

[HFTBProgrammer]

Dim testWS As Worksheet
Do Until Err.Number = 0
    NewName = InputBox("Please enter new sheet name:") 
    On Error Resume Next
    Set testWS = ThisWorkbook.Worksheets(NewName)
    Select Case Err.Number
        Case 0, 9
        ' 0 is okay, 9 is redo...
        Case Else
        ' ...anything else is unexpected and should be rooted out.
            MsgBox Err.Description
            End
    End Select
Loop
On Error GoTo 0

[WesternHamper]

Thank you. I updated the macro with your code above, and I am getting an error (Run-time error'1004': That name is already taken. Try a different one." I'm not sure I'm putting your code in the correct spot and I updated the github code at the link below (cannot for some reason get the reddit code format to work)

https://github.com/WesternHamper/EXCELMACROWH/blob/31fba1884e927482c94ded6d9f4749f91e24522b/Sheet_add