Excel rename sheet with if sheet name already exists - excel

How can i rename a sheet and add a number to the end of the name if the name already exists.
I'm using this code but need to add a number to the end of sheet name if name already exists.
VBA_BlankBidSheet.Copy After:=ActiveSheet
ActiveSheet.Name = "New Name"

The code below loops through all worksheets in ThisWorkbook and checks if there is already a sheet with a name of "New Name", if it does it adds a number at the end.
Sub RenameSheet()
Dim Sht As Worksheet
Dim NewSht As Worksheet
Dim VBA_BlankBidSheet As Worksheet
Dim newShtName As String
' modify to your sheet's name
Set VBA_BlankBidSheet = Sheets("Sheet1")
VBA_BlankBidSheet.Copy After:=ActiveSheet
Set NewSht = ActiveSheet
' you can change it to your needs, or add an InputBox to select the Sheet's name
newShtName = "New Name"
For Each Sht In ThisWorkbook.Sheets
If Sht.Name = "New Name" Then
newShtName = "New Name" & "_" & ThisWorkbook.Sheets.Count
End If
Next Sht
NewSht.Name = newShtName
End Sub

The test procedure on a new workbook will generate these sheet names:
Sheet1_1, Sheet2_1 and ABC.
If Sheet1_1 exists and we ask for a new Sheet1 it will return Sheet1_2, as ABC doesn't exist in a new workbook it will return ABC.
The Test code adds a new sheet called 'DEF'. If you run it a second time it will create 'DEF_1'.
Sub Test()
Debug.Print RenameSheet("Sheet1")
Debug.Print RenameSheet("Sheet2")
Debug.Print RenameSheet("ABC")
Dim wrkSht As Worksheet
Set wrkSht = Worksheets.Add
wrkSht.Name = RenameSheet("DEF")
End Sub
Public Function RenameSheet(SheetName As String, Optional Book As Workbook) As String
Dim lCounter As Long
Dim wrkSht As Worksheet
If Book Is Nothing Then
Set Book = ThisWorkbook
End If
lCounter = 0
On Error Resume Next
Do
'Try and set a reference to the worksheet.
Set wrkSht = Book.Worksheets(SheetName & IIf(lCounter > 0, "_" & lCounter, ""))
If Err.Number <> 0 Then
'If an error occurs then the sheet name doesn't exist and we can use it.
RenameSheet = SheetName & IIf(lCounter > 0, "_" & lCounter, "")
Exit Do
End If
Err.Clear
'If the sheet name does exist increment the counter and try again.
lCounter = lCounter + 1
Loop
On Error GoTo 0
End Function
Edit: Removed the Do While bNotExists as I wasn't checking bNotExists - just using Exit Do instead.

Building on Darren's answer, I thought it might be easier to just rename the sheet right away instead of returning the name that can be used. I also refactored a bit. Here's my take:
Private Sub nameNewSheet(sheetName As String, newSheet As Worksheet)
Dim named As Boolean, counter As Long
On Error Resume Next
'try to name the sheet. If name is already taken, start looping
newSheet.Name = sheetName
If Err Then
If Err.Number = 1004 Then 'name already used
Err.Clear
Else 'unexpected error
GoTo nameNewSheet_Error
End If
Else
Exit Sub
End If
named = False
counter = 1
Do
newSheet.Name = sheetName & counter
If Err Then
If Err.Number = 1004 Then 'name already used
Err.Clear
counter = counter + 1 'increment the number until the sheet can be named
Else 'unexpected error
GoTo nameNewSheet_Error
End If
Else
named = True
End If
Loop While Not named
On Error GoTo 0
Exit Sub
nameNewSheet_Error:
'add errorhandler here
End Sub

The .net version of VB uses the Try ... Catch formulation to catch runtime errors, see {https://msdn.microsoft.com/en-us/library/ms973849.aspx}(https://msdn.microsoft.com/en-us/library/ms973849.aspx) for a comparison with the old "on error" formulation of VB6 and before. It is better suited to do what you want, and will make shorter exception runs imho.
I'm trying to find out what exception is thrown when trying to rename to an existing sheetname, and will edit here to a workable script when i find it.

Related

Vba code to rename a sheet or show an error

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.
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.
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#
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

How to jump to worksheet by typing partial name

I have the below code I use to jump to sheets. It requires the exact name to typed in order to be found. Is there a way to have it jump to a sheet by typing in part of the sheet name?
For example, I have a large workbook with sheets named by their ID and currency. If I know the ID but not the currency I would like to be able to jump to the sheet.
My code:
Sub SelectSheet()
Dim i As Variant
Dim ws As Worksheet
i = Application.InputBox("Enter worksheet name", "Select sheet")
'Cancel was pressed
If i = False Or Trim(i) = "" Then Exit Sub
'Check if sheet exist
On Error Resume Next
Set ws = Sheets(i)
On Error GoTo 0
If ws Is Nothing Then
MsgBox "Worksheet " & i & " not found!"
Else
Sheets(i).Select
End If
End Sub
Any ideas?
This will do a partial name match on the beginning of each sheet name. Adjust accordingly to fit your needs.
It works by matching the first x number of characters of each sheet name, where the value of x is determined by the number of characters you entered. You may need to handle case-conversion (e.g., converting the input to uppercase to remove case-sensitivity).
Sub SelectSheet()
Dim Temp As Variant
Dim ws As Worksheet
Temp = Application.InputBox("Enter worksheet name", "Select sheet")
'Cancel was pressed
If Temp = False Or Trim(Temp) = "" Then Exit Sub
'Check if sheet exist
On Error Resume Next
For i = 1 To Sheets.Count
If Left(Sheets(i).Name, Len(Temp)) = Temp Then ' Match first letters
Set ws = Sheets(i) ' Found it
End If
Next
Set ws = Sheets(i)
On Error GoTo 0
If ws Is Nothing Then
MsgBox "Worksheet " & Temp & " not found!"
Else
ws.Select
End If
End Sub

Rename Worksheet with Dropdown list

I am using the below code to rename worksheet.
Option Explicit
Sub RenWSs()
Dim ws As Worksheet
Dim shtName
Dim newName As String
Dim i As Integer
Dim RngStr As String
RngStr = Application.InputBox(prompt:="Select the Range for the new Sheet's name", Type:=2)
For Each ws In Worksheets
With ws
If Trim(.Range(RngStr)) <> "" Then
shtName = Split(Trim(.Range(RngStr)), " ")
newName = shtName(0)
On Error GoTo ws_name_error
.Name = .Range(RngStr)
GoTo done
repeat:
.Name = newName & i
GoTo done
ws_name_error:
i = i + 1
Resume repeat
End If
End With
On Error GoTo 0
done:
Next
End Sub
In this i am selecting the new name through Input Box and its working fine. Now what i want is, before calling the input box, the below process has to be done.
I have names in drop down list, each names in drop down list to be updated one by one in all worksheets like J16 is the cell.
Please help me
The code below will lopp through all ws sheets, and modifies the value of cell in "J16" to "Test 1" (just for testing purposes).
Option Explicit
Sub ModifyDropDownValue()
Dim ws As Worksheet
For Each ws In Worksheets
With ws
' modify the value in cell J16
.Range("J16").Value = "Test 1"
End With
Next ws
End Sub

Duplicate sheets shouldn't be added

I would like to write a vba code that will not allow to add duplicate sheets with same name. I have a code that is assigned to button on the sheet that is used to change the name of the active sheet.
Sheets are copied from "Main" sheet and hence all the sheets will have button to rename the sheet based on the value selected in the cells A8 and K11 (Both these cells have drop down list with values).
My concern is when user selects the button to rename the sheet, it should look for all the sheets in workbook and display a message if duplicate sheet exists else it should rename the sheet. I am confused in passing values, I am still a starter. Please help
Sub RenameCurrentSheet()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim ws As Worksheet
ThisWorkbook.Unprotect Password:="xyz"
For x = 1 To worksh
If ActiveSheet.Name = "MainSheet" Then
MsgBox "You Cannot Change Name of This Sheet!!!"
Exit For
Else
ActiveSheet.Name = Range("A8").Value & "-" & Range("K11").Value
Exit For
End If
Next x
Application.DisplayAlerts = True
ThisWorkbook.Protect Password:="xyz"
End Sub
To iterate through the worksheets use code like this:
dim wks as Worksheet
for I = 1 to Application.Worksheets.Count
set wks = Application.Worksheets(i)
Debug.Print wks.Name
.... whatever else you want do do
next i
set wks = Nothing ' When done with the object
Just try and reference the worksheet to see if it exists - if it throws an error, then the sheet doesn't exist.
Your code fails as you're always looking at the activesheet, but never changing which sheet is active.
Public Sub CopyAndRenameSheet()
Dim wrkSht As Worksheet
Dim sNewName As String
With ThisWorkbook
'Copy the template to the end of the workbook.
.Worksheets("MainSheet").Copy After:=.Sheets(.Sheets.Count)
'Set reference to last sheet in workbook (the one you've just copied).
Set wrkSht = .Worksheets(.Sheets.Count)
With wrkSht
'Get the new name from the ranges.
sNewName = .Range("A8") & "-" & .Range("K11")
If WorkSheetExists(sNewName) Then
MsgBox "You Cannot Change Name of This Sheet!!!", vbOKOnly + vbCritical
'Do something with the sheet, otherwise you'll be left with a
'sheet called something like "MainSheet (1)".
Application.DisplayAlerts = False
wrkSht.Delete
Application.DisplayAlerts = True
Else
.Unprotect Password:="xyz"
wrkSht.Name = sNewName
.Protect Password:="xyz"
End If
End With
End With
End Sub
Public Function WorkSheetExists(SheetName As String, Optional WrkBk As Workbook) As Boolean
Dim wrkSht As Worksheet
If WrkBk Is Nothing Then
Set WrkBk = ThisWorkbook
End If
On Error Resume Next
Set wrkSht = WrkBk.Worksheets(SheetName)
WorkSheetExists = (Err.Number = 0)
Set wrkSht = Nothing
On Error GoTo 0
End Function
This code copies the name to be assigned from the template instead of the ActiveSheet. If you create the name from the active sheet and make sure that the name meets Excel requirements for sheet names, this code ought to work.

Getting sheet indice from Sheet Name in VBA

I need to pull a sheet's position in a workbook knowing only it's name -- so for instance:
if we have a sheet, say
Workbook.Sheets("Sheet2")
how would I find the corresponding integer so that I could refer to it as:
say i is an integer
Workbook.Sheets(i)
I need to be able to do this reverse indicing so I can refer to sheets next to the sheet I'm referencing.
Thank you for your help.
Workbook.Sheets("sheet name").Index
Edit: brettdj's answer inspired me, so I wrote this function which could probably be cleaned up infact thinking about it, if I were actually going to use and support this I would probably make a find sheet function instead of what the sub does if you say true for the 4th parameter:
Function adjacentsheet(Optional ws As Worksheet, Optional wsName As String, Optional nextSheet As Boolean = True, Optional search As Boolean = False) As Worksheet
'Expects worksheet or worksheet.name if blank, uses activesheet.
'Third parameter indicates if the next sheet or previous sheet is wanted, default is next = true
'Indicates adjacent sheet based on worksheet provided.
'If worksheet is not provided, uses worksheet.name.
'If no worksheet matches corresponding name, checks other workbooks if 4th parameter is true
'If no worksheet can be found, alerts the user.
'Returns found worksheet based upon criteria.
If (ws Is Nothing) Then
If wsName = "" Then
Set adjacentsheet = adjacentsheet(ActiveSheet, , nextSheet)
Else
'Check all workbooks for the wsName, starting with activeWorkbook
On Error Resume Next
Set ws = Sheets(wsName)
On Error GoTo 0
If (ws Is Nothing) Then
If search = True Then
If Workbooks.Count = 1 Then
GoTo notFound
Else
Dim wb As Workbook
For Each wb In Application.Workbooks
On Error Resume Next
Set ws = wb.Sheets(wsName)
On Error GoTo 0
If Not (ws Is Nothing) Then
Set adjacentsheet = adjacentsheet(ws, , nextSheet)
Exit For
End If
Next
If (ws Is Nothing) Then GoTo notFound
End If
Else
GoTo notFound
End If
Else
Set adjacentsheet = adjacentsheet(ws, , nextSheet, search)
End If
End If
Else
With ws.Parent
If nextSheet Then
If ws.Index = .Sheets.Count Then
Set adjacentsheet = .Sheets(1)
Else
Set adjacentsheet = .Sheets(ws.Index + 1)
End If
Else
If ws.Index = 1 Then
Set adjacentsheet = .Sheets(.Sheets.Count)
Else
Set adjacentsheet = .Sheets(ws.Index - 1)
End If
End If
End With
End If
Exit Function
notFound:
MsgBox "Worksheet name could not be found!", vbCritical, "Invalid worksheet name."
End Function
Here are some usage examples:
'Usage Examples
Dim nextws As Worksheet
'returns sheet before the active sheet
Set nextws = adjacentsheet(, , False)
'returns sheet after the active sehet
Set nextws = adjacentsheet()
'returns sheet after sheet named "Test" in current workbook
Set nextws = adjacentsheet(, "Test")
'returns sheet after sheet named "Test" in any open workbook checking current workbook first
Set nextws = adjacentsheet(, "Test", , True)
If you want to refer to the Next or Previous sheet then you can do this without incrementing the starting sheet position
Sub Test()
If Sheets.Count > ActiveSheet.Index Then
Debug.Print "next method: " & ActiveSheet.Next.Name
Debug.Print "index method: " & Sheets(ActiveSheet.Index + 1).Name
Else
Debug.Print "Active Sheet is the last sheet"
End If
End Sub

Resources