Auto renaming sheet, warning if name exists

M

miicker

Board Regular
Joined
Jun 1, 2014
Messages
75
I am currently using the following code:
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.
 
Last edited:
Sort by date Sort by votes
Hey steve, fair enough, seemed faster to directly assign a variable (even in a function) than using looping to find a match in a loop or not, so was wondering why loop
 
Upvote 0

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
I would use this:
I would think needing the user to install a script and a function is something some users may not understand.

Looping through the sheets even if you have 5,000 sheets would probable take 2.3 seconds
And who has 5,000 sheets.

Code: 
Sub CopyTable()
Dim ans As String
Sheets("Brongegevens").Select
ans = Range("CodeCopyTabblad").Value
    For i = 1 To Sheets.Count
        If Sheets(i).Name = ans Then
            MsgBox "Sheet named " & Range("CodeCopyTabblad").Value & " already exist" & vbNewLine & "This script will now stop"
            Exit Sub
        End If
    Next
    Sheets("Brongegevens").Copy After:=Sheets(1)
    ActiveSheet.Name = Range("CodeCopyTabblad").Value
End Sub
 
Upvote 0
@miicker
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.
Click to expand...

I've adjusted the message if the sheet already exists and given an option to delete existing sheet and replace with a copy of sheet("Brongegevans") renamed to Range("CodeCopyTabllad").Value or renamed to a User provided name. It doesn't test if the User provides a name that also already exists, so be aware of that. Anyway, try:
Rich (BB code): 
Sub CopyTable()
    
    Dim wks As Worksheet
    Dim msg As String
    
    With Range("CodeCopyTabllad")
        On Error Resume Next
        Set wks = Sheets(.Value)
        On Error GoTo 0
    
        If Not wks Is Nothing Then
        
            msg = "Sheet with name: @VAL@1@1Already exists!@1@!Click Ok to Replace or Cancel to Exit"
            msg = Replace(msg,  "@VAL", .Value)
            msg = Replace(msg, "@1", vbCrLf)
            
            If MsgBox(msg, vbOKCancel, "Sheet Already Exists") = vbOK Then
                Application.DisplayAlerts = False
                wks.Delete
                Application.DisplayAlerts = False
                msg = "Click Cancel to use @VAL as sheet name or provide one: "
                msg = Replace(msg,  "@VAL", .Value)
                msg = InputBox(msg, "New Sheet Name")
            Else
                MsgBox "New sheet not created", vbOKOnly, "New Sheet Not Created"
                Exit Sub
            End If
            
        End If
        Sheets("Brongegevens").Copy after:=Sheets(1)
        ActiveSheet.Name = IIf(LenB(msg), msg, .Value)
        
    End With
    
End Sub
 
Last edited:
Upvote 0
Thanks for the replies, I went with the approach of @steve the fish

I saw that I made a mistake in the rest of the code, thats why the other sheet got deleted as well. I solved that.

@JackDanIce I tried your approach, but I get an error:
Run-time error '1004':
Method 'Range' of object'_Global' failed

on this line:
With Range("CodeCopyTabllad")

I'm using Excel 2010 btw.
 
Upvote 0
I typed the name range wrong, should have been CodeCopyTabblad not CodeCopyTabllad. Correct that and try running
 
Last edited:
Upvote 0
JackDanIce said:
I typed the name range wrong, should have been CodeCopyTabblad not CodeCopyTabllad. Correct that and try running
Click to expand...

Thanks, it works good now. Sorry that I haven't noticed that mistake myself.
One question about the code you provided.
When I choose OK if the worksheet already exists and give it a different name, it still removes the old one, what I would like to happen is as follows:

If the sheet does not exist:
Same as now, just create the sheet and rename it the way it is done right now.

If the sheet does exist:
Give the user three options:
Cancel the action, leave it as is, so don't replace the current sheet
Replace the current sheet
Rename the sheet, give it a new name and keep both
 
Upvote 0
Replace all of the code with below and try:
Code: 
Sub CopyTable()
    
    Dim wks     As Worksheet
    Dim msg     As String
    Dim sName   As String
    
    sName = Range("CodeCopyTabblad").Value
        
    On Error Resume Next
    Set wks = Sheets(sName)
    On Error GoTo 0        
        
    If Not wks Is Nothing Then
        Select Case SheetExists(sName)
            Case Is = vbYes
                DeleteSheet wks
                msg = sName
            Case Is = vbNo
                msg = InputBox("Please enter new sheet name: ")
                If Len(msg) = 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"), msg            
        
    MsgBox "Sheet: " & msg & " has been created", vbOKOnly, "Sheet Created"
    
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
 
Last edited:
Upvote 0
JackDanIce said:
Replace all of the code with below and try:
Code: 
Sub CopyTable()
    
    Dim wks     As Worksheet
    Dim msg     As String
    Dim sName   As String
    
    sName = Range("CodeCopyTabblad").Value
        
    On Error Resume Next
    Set wks = Sheets(sName)
    On Error GoTo 0        
        
    If Not wks Is Nothing Then
        Select Case SheetExists(sName)
            Case Is = vbYes
                DeleteSheet wks
                msg = sName
            Case Is = vbNo
                msg = InputBox("Please enter new sheet name: ")
                If Len(msg) = 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"), msg            
        
    MsgBox "Sheet: " & msg & " has been created", vbOKOnly, "Sheet Created"
    
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
Click to expand...

Thanks for the help, but now I receive the following error:
Run-time error '1004':
Application-defined or object-defined error

When I debug, it highlights "ActiveSheet.Name = sName"
In:
Code: 
Private Sub AddSheet(ByRef wks As Worksheet, ByRef sName As String)    wks.Copy after:=Sheets(1)
    ActiveSheet.Name = sName
    
End Sub

When I hoover over sName, I see that the variable is empty. I tried to fill the variable in that private sub, but htewn I get an error if the sheet already exists.
 
Last edited:
Upvote 0
What does the line in blue message box say when macro runs:
Rich (BB code): 
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"
                End If
            Case Is = vbCancel
                MsgBox "No sheets added", vbOKOnly, "No sheets added"
        End Select
    End If
    
    If sName(2) <> sName(1) Or Len(sName(2)) = 0 Then Exit Sub
    MsgBox "Name of sheet about to be created is: " & sName(2), vbOKOnly
    
    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
 
Last edited:
Upvote 0
JackDanIce said:
What does the line in blue message box say when macro runs:
Rich (BB code): 
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"
                End If
            Case Is = vbCancel
                MsgBox "No sheets added", vbOKOnly, "No sheets added"
        End Select
    End If
    
    If sName(2) <> sName(1) Or Len(sName(2)) = 0 Then Exit Sub
    MsgBox "Name of sheet about to be created is: " & sName(2), vbOKOnly
    
    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
Click to expand...

Without changing anything to the code it works, but only if the sheet does not exist. If it does exist it gives me an error on this line:
ActiveSheet.Name = sName

In this code:
Code: 
Private Sub AddSheet(ByRef wks As Worksheet, ByRef sName As String)

    wks.Copy after:=Sheets(1)
    ActiveSheet.Name = sName
    ActiveWorkbook.Connections("ConnectionName").Delete
    
End Sub

Error:
Run-time error '1004':
Cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced by Visual Basic.

The message box displays the right name. Also the variable in the highlited code (of the error) shows the right name.
 
Last edited by a moderator:
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
Rename Excel Worksheet By Auto Increment
Replies
4
Views
479
footoo
F
R
  • Question
Creating a loop to rename worksheets
Replies
4
Views
488
Micron
M
tourless
  • Solved
Programmatically renaming sheets with variables
Replies
5
Views
751
Joe4
Joe4
T
  • Solved
Duplicate and rename a sheet based on a cell text
Replies
3
Views
324
skillilea
S
J
  • Question
VBA to make Sheet Name = Cell Value
2
Replies
15
Views
673
Joe4
Joe4

Forum statistics

Threads
1,216,077
Messages
6,128,673
Members
449,463
Latest member
Jojomen56

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top