Auto renaming sheet, warning if name exists

[miicker]

I am currently using the following code:

Sub CopyTable()    Sheets("Brongegevens").Select
    Sheets("Brongegevens").Copy After:=Sheets(1)
    ActiveSheet.Name = Range("CodeCopyTabblad").Value
    End Sub

This code copies a worksheet, and then renames it to whatever value is in the named range "CodeCopyTabblad".
This works fine, except when the name already exists, I get a VBA error.

What I would like to happen is a user friendly error, which says something like
"This worksheet already exists, please choose a different name or delete the old worksheet first"

Optionally would be an option to overwrite the worksheet, and/or present an input field where the user can type the new name.
I'm not that good in VBA, so I have no idea where to start.

Thanks in advance.

 

[JackDanIce]

Think there was an error in the logic, try:

Sub CopyTable()
    
    Dim wks             As Worksheet
    Dim sName(1 To 2)   As String
    
    sName(1) = Range("CodeCopyTabblad").Value
    sName(2) = sName(1)
    
    On Error Resume Next
    Set wks = Sheets(sName(1))
    On Error GoTo 0
                
    If Not wks Is Nothing Then
        Select Case SheetExists(sName(1))
            Case Is = vbYes
                DeleteSheet wks
            Case Is = vbNo
                sName(2) = InputBox("Please enter new sheet name: ")
                If Len(sName(2)) = 0 Then
                    MsgBox "No name provided, macro stopping", vbExclamation, "No Name Provided"
                    Exit Sub
                End If
            Case Is = vbCancel
                MsgBox "No sheets added", vbOKOnly, "No sheets added"
                Exit Sub
        End Select
    End If
    
    AddSheet Sheets("Brongegevens"), sName(2)
        
    MsgBox "Sheet: " & sName(2) & " has been created", vbOKOnly, "Sheet Created"
    Erase sName
    
End Sub
Private Function SheetExists(ByRef sName As String) As String

    SheetExists = "Sheet with name: @VAL@1@1Already exists!@1@!Click Yes to Delete and Replace@1@1Click No to add new sheet with user name@1@1Or click Cancel to Exit"
    
    SheetExists = Replace(SheetExists, "@VAL", sName)
    SheetExists = Replace(SheetExists, "@1", vbCrLf)
        
End Function

Private Sub DeleteSheet(ByRef wks As Worksheet)
    
    Application.DisplayAlerts = False
    wks.Delete
    Application.DisplayAlerts = False
    
End Sub

Private Sub AddSheet(ByRef wks As Worksheet, ByRef sName As String)

    wks.Copy after:=Sheets(1)
    ActiveSheet.Name = sName
    
End Sub

 

[miicker]

Think there was an error in the logic, try:

Sub CopyTable()
    
    Dim wks             As Worksheet
    Dim sName(1 To 2)   As String
    
    sName(1) = Range("CodeCopyTabblad").Value
    sName(2) = sName(1)
    
    On Error Resume Next
    Set wks = Sheets(sName(1))
    On Error GoTo 0
                
    If Not wks Is Nothing Then
        Select Case SheetExists(sName(1))
            Case Is = vbYes
                DeleteSheet wks
            Case Is = vbNo
                sName(2) = InputBox("Please enter new sheet name: ")
                If Len(sName(2)) = 0 Then
                    MsgBox "No name provided, macro stopping", vbExclamation, "No Name Provided"
                    Exit Sub
                End If
            Case Is = vbCancel
                MsgBox "No sheets added", vbOKOnly, "No sheets added"
                Exit Sub
        End Select
    End If
    
    AddSheet Sheets("Brongegevens"), sName(2)
        
    MsgBox "Sheet: " & sName(2) & " has been created", vbOKOnly, "Sheet Created"
    Erase sName
    
End Sub
Private Function SheetExists(ByRef sName As String) As String

    SheetExists = "Sheet with name: @VAL@1@1Already exists!@1@!Click Yes to Delete and Replace@1@1Click No to add new sheet with user name@1@1Or click Cancel to Exit"
    
    SheetExists = Replace(SheetExists, "@VAL", sName)
    SheetExists = Replace(SheetExists, "@1", vbCrLf)
        
End Function

Private Sub DeleteSheet(ByRef wks As Worksheet)
    
    Application.DisplayAlerts = False
    wks.Delete
    Application.DisplayAlerts = False
    
End Sub

Private Sub AddSheet(ByRef wks As Worksheet, ByRef sName As String)

    wks.Copy after:=Sheets(1)
    ActiveSheet.Name = sName
    
End Sub

I'll now get a different error, the error occurs at the same line, when the worksheet already exists this is the error:
Run-time error '1004':
The name is already taken. Try a different one.

 

[miicker]

Got everything working now! Very satisfied with the code. Used a bit of everything here and some other things I found on the internet. It might help people in the future, I've tried explaining the code in commands:

Private AltName2 As String
''''Begin''''Sub CopyTable()
Dim OutPut As Integer
Dim msg As String
Dim msg2 As String
' Checks if the worksheet that is being created exists
If SheetExists(Range("CodeCopyTabblad").Value) = True Then
' Shows message if worksheet already exists
     msg = "There is already a worksheet with the name ""@VAL""@1@1Do you want to replace this worksheet?@1@1Choose ""Yes"" to replace the worksheet, ""No"" to change the name of the worksheet ""Cancel"" to cancel what you are doing."
            msg = Replace(msg, "@VAL", Range("CodeCopyTabblad").Value)
            msg = Replace(msg, "@1", vbCrLf)
    OutPut = MsgBox(msg, vbYesNoCancel, "Warning")
If OutPut = 6 Then
    'If Yes is chosen
        Application.DisplayAlerts = False
        Sheets(Range("CodeCopyTabblad").Value).Delete
        Application.DisplayAlerts = False
        Sheets("Masterdata").Copy After:=Sheets(1)
        ActiveSheet.Name = Range("CodeCopyTabblad").Value
    MsgBox "Replace worksheet!", vbInformation, "Yes - 6"
    ElseIf OutPut = 7 Then
    'If No is chosen
    msg2 = "There is already a worksheet with the name ""@VAL""@1@1Do you want to replace this worksheet?@1@1Typ the name and press ""OK"" to apply the name.@1Choose ""Cancel"" if you wan't to cancel what you are doing"
        msg2 = Replace(msg2, "@VAL", Range("CodeCopyTabblad").Value)
        msg2 = Replace(msg2, "@1", vbCrLf)
        AltName = Application.InputBox(msg2, "Choose a unique name for the worksheet")
        'If cancel is choosen
        If AltName = False Then
            MsgBox "Canceled", vbCritical, "Warning"
            End
        End If
        'If no name is entered
        If AltName = "" Then
            MsgBox "The name was empty, action is canceled", vbCritical, "Error"
            End
        End If
        AltName2 = AltName
        'Checks if the name that is entered exists
        If SheetExists2(AltName2) = True Then
            MsgBox "This name is already taken", vbCritical, "Error"
            End
        End If
        'If the name did not exist
            Sheets("Masterdata").Copy After:=Sheets(1)
            ActiveSheet.Name = AltName
        Else
        'If canceled
        MsgBox "Handeling geannuleerd.", vbInformation, "Cancel - 2"
        End
    End If
Exit Sub
Else
    Sheets("Masterdata").Copy After:=Sheets(1)
    ActiveSheet.Name = Range("CodeCopyTabblad").Value
End If


End Sub


Function SheetExists(sheetToFind As String) As Boolean
    SheetExists = False
    For Each Sheet In Worksheets
        If UCase(Sheet.Name) = UCase(Range("CodeCopyTabblad").Value) Then
            SheetExists = True
            Exit Function
        End If
    Next Sheet
End Function


Function SheetExists2(sheetToFind As String) As Boolean
    SheetExists2 = False
    For Each Sheet In Worksheets
        If UCase(Sheet.Name) = UCase(AltName2) Then
            SheetExists2 = True
            Exit Function
        End If
    Next Sheet
End Function
''''End''''

 

[JackDanIce]

Glad it's resolved