I am using Excel 2013. I have the macro that adds a new sheet and renames it. But when I run the macro for the second time, it throws an error because there is a sheet with the name that was just created. For example, I create a sheet and name it Account, the next time when I run the macro I want it to be Account1 and next time Account2 and so on.
Without seeing the rest of your code, see below, which assumes you want to create 10 new tabs, starting with Account1, and ending with Account10. It works by using the counter variable to count down from 10, and each time it creates the new tab, it simply appends the counter's value to "Account" for the sheetname.
Sub Sheet_Creation()
Dim counter As Integer
For counter = 10 To 1 Step -1
Sheets.Add.Name = "Account" & counter
Next counter
End Sub
This procedure will add a new worksheet and name it properly:
Sub AddWS()
Const WS_NAME = "Account"
Dim c
On Error Resume Next
With Sheets.Add(, ActiveSheet)
Do
.Name = WS_NAME & c
If Err = 1004 Then
c = c + 1
Err.Clear
Else
Exit Do
End If
DoEvents
Loop
End With
End Sub
Note: you can manage the base name applied to the newly created worksheet by editing the first line.
UPDATE
Based on your new requirement to be able to access the newest worksheet created at a later point by using the base name ('Account' in your question), please use this version of the above procedure:
Sub AddWS()
Const WS_NAME = "Account"
Dim c
On Error Resume Next
With Sheets.Add(, ActiveSheet)
Do
.Name = WS_NAME & c
If Err = 1004 Then
c = c + 1
Err.Clear
Else
Exit Do
End If
DoEvents
Loop
ThisWorkbook.Names.Add "Newest_" & WS_NAME, .Name
End With
End Sub
Now, later on when you wish to select that sheet, you can use this code:
Sheets([Newest_Account]).Select
Private Sub CreateSheet()
Dim ws As Worksheet
With ActiveWorkbook
Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
ws.Name = "Account" & Worksheets.Count
End With
End Sub
The above macro will create new sheets named Account#, with # = the total number of sheets.
Related
I'm using the following code to check in a workbook whether sheet1 and sheet2 exist or not. If they do not exist then they're supposed to be generated. Otherwise, nothing should happen.
My problem is the macro only works for the first iteration when neither of the worksheets exists. Once the worksheets are created I get an error. Something like "Name already exists. Choose a different one…." I don't want anything to happen if sheet1 and sheet2 already exist.
Sub Worksheet()
Dim x As Integer, blnFound1 As Boolean, blnFound2 As Boolean
blnFound1 = False
blnFound2 = False
With ThisWorkbook
For x = 1 To .Sheets.Count
If .Sheets(x).Name = "Sheet1" Then
blnFound1 = True
Exit For
End If
If .Sheets(x).Name = "Sheet2" Then
blnFound2 = True
Exit For
End If
Next x
If blnFound1 = False Then
.Sheets.Add
With ActiveSheet
.Name = "Sheet1"
End With
End If
If blnFound2 = False Then
.Sheets.Add
With ActiveSheet
.Name = "Sheet2"
End With
End If
End With
End Sub
I use a different macro on every project to handle this, so you can use it whenever you want:
Sub TestSheet(SheetName As String)
Dim Exists As Boolean
With ThisWorkbook
On Error Resume Next
Exists = (.Worksheets(SheetName).Name <> "")
On Error GoTo 0
If Not Exists Then
.Sheets.Add After:=.Sheets(.Sheets.Count)
.Sheets(.Sheets.Count).Name = SheetName
End If
End With
End Sub
This is how you test:
Sub Test()
TestSheet "Sheet1"
TestSheet "Sheet2"
End Sub
What if you want to use the new Worksheet only if it didn't exist?
In that scenario, I would use a Try-Parse Pattern.
To do this, create a function that takes in the sheet name and a ByRef parameter that can return your newly created worksheet object.
Public Function TryCreateWorksheet(ByVal SheetName As String, Optional ByRef outWorksheet As Worksheet, Optional ByRef Source As Workbook) As Boolean
'If workbook not passed in then set it to the activeworkbook.
If Source Is Nothing Then
Set Source = ActiveWorkbook
End If
If Not WorksheetExists(SheetName, Source) Then
'Return true, then set outWorksheet to created worksheet and rename it.
TryCreateWorksheet = True
Set outWorksheet = Source.Worksheets.Add(After:=Source.Worksheets(Source.Worksheets.Count))
outWorksheet.Name = SheetName
End If
End Function
Here is the function for checking if the worksheet exists. It's good to be explicit in which Workbook you want to check so you don't run into any errors.
Public Function WorksheetExists(ByVal SheetName As String, ByRef Source As Workbook) As Boolean
On Error Resume Next
WorksheetExists = (Source.Worksheets(SheetName).Name <> "")
On Error GoTo 0
End Function
How to use it?
If the worksheet is created then the function returns true and you can safely know you have a reference to your new worksheet.
You could use this in an if statement to see if it returns true. If so, you can now use your worksheet object. See below:
Private Sub SomeProcedure()
Dim CreatedWs As Worksheet
If TryCreateWorksheet("Sheet3", CreatedWs, ActiveWorkbook) = False Then
MsgBox "Sheet already exists", vbInformation
Exit Sub
End If
'Do Something with your created Ws
Debug.Print CreatedWs.Name
End Sub
What if you'd like a unique name when the worksheet exists?
In that case, you could add a unique index to the end of the sheet names.
For example, if you have Sheet1 the next unique name would be Sheet1 (2) and so forth.
Public Function UniqueSheetName(ByVal Name As String, ByRef Source As Workbook) As String
'Used to create a new unique name
Dim NewName As String
NewName = Name
'Used to increment the name index. ie: Sheet1(1)
Dim Index As Integer
Index = 1
NameLoop:
'If exists then change name to include increment (n)
If WorksheetExists(NewName, Source) Then
Index = Index + 1
NewName = Name & " (" & Index & ")"
GoTo NameLoop
End If
UniqueSheetName = NewName
End Function
I duplicate a report and rename the tab as per user input.
I need to take that user input and insert it into a formula which would then be placed into a cell. Over time (monthly) the formula would need to change columns.
Below is what I have done so far.
sName is the user defined input, I think I have declared it as a global variable correctly
sName is used in SPVCLookup as the name of the tab (not working)
sName is used in countif as part of a formula (not working)
' will copy SPC Report to new tab and ask user to name the tab
Dim sName As String
Sub CopyRename()
'Dim sName As String
Dim wks As Worksheet
Worksheets("SPC Report").Copy after:=Sheets(Worksheets.Count)
Set wks = ActiveSheet
Do While sName <> wks.Name
sName = Application.InputBox _
(Prompt:="Enter new worksheet name")
On Error Resume Next
wks.Name = sName
On Error GoTo 0
Loop
Set wks = Nothing
End Sub
'------------------------
Sub CreateDA()
Dim ws As Worksheet
With ThisWorkbook
Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
ws.Name = "Departmental Analysis"
End With
End Sub
'------------------------
Sub SPCVlookup()
'Sheets("sName").Select 'this needs to be user defined
Range(Range("E2"), Range("E2").End(xlDown)).Formula = "=VLOOKUP(D2,'Card Exchange'!$A$1:$V$218,6,FALSE)"
End Sub
Sub Countif()
Sheets("Departmental Analysis").Select
' I think I need a for loop to cycle through the range columns
Range(Range("E2"), Range("E2").End(xlDown)).Formula = "=COUNTIFS('sname'!$A$1:$E$12104,A3)"
End Sub
You've got two problems here.
Sub SPCVlookup()
Sheets("sName").Select 'selects the sheet called "sName"
Range(Range("E2"), Range("E2").End(xlDown)).Formula = "=VLOOKUP(D2,'Card Exchange'!$A$1:$V$218,6,FALSE)"
End Sub
This code selects the sheet called "sName". Remove the "" marks:
Sub SPCVlookup()
Sheets("sName").Select 'selects the sheet called "sName"
Range(Range("E2"), Range("E2").End(xlDown)).Formula = "=VLOOKUP(D2,'Card Exchange'!$A$1:$V$218,6,FALSE)"
End Sub
Range(Range("E2"), Range("E2").End(xlDown)).Formula = "=COUNTIFS('sname'!$A$1:$E$12104,A3)"
This is a bit trickier. You'll need to copy sName into the formula, but in order to do so you'll need to escape it (just in case sName contains quotes). You can do that by doubling each quote:
Replace(sName, """", """"&"""")
So...
Range(Range("E2"), Range("E2").End(xlDown)).Formula = "=COUNTIFS('" & Replace(sName, """", """"&"""") & "'!$A$1:$E$12104,A3)"
This won't update the cells when sName changes; to do that, you'll need to set a spreadsheet name. Variables in VBA and Formulas aren't shared.
I want to check if the sheet named "test" exists and if not, create and name that sheet to "test".
If it exists, I run a separate block of code which I haven't put up here. I have used error handling in that it ignores the error if it happens.
If Sheets("test").Name = "" Then
'MsgBox Sheets("test").Name & "Name"
.Worksheets.Add After:=ThisWorkbook.Worksheets("test2")
.ActiveSheet.Name = "test"
End If
No matter what I do, this section of the code always runs and creates a new sheet.
The code runs properly if the sheet "test" doesn't exist already. It creates a new sheet and renames it and moves on. Obviously it doesn't rename the sheet in the other case since there's already another sheet "test" with the same name.
If you're not too familiar with VBA, you could use this rather than a function:
Sub checkSheet()
For i = 1 To Worksheets.Count
If Worksheets(i).Name = "MySheet" Then
exists = True
End If
Next i
If Not exists Then
Worksheets.Add.Name = "MySheet"
End If
End Sub
Not quite sure why you're getting additional worksheets added, but I would use and external function to check whether the worksheet exists...
I would also add some error checking for "test2" so here is some code which you should be able to adapt
Sub Test()
Dim wsName As String: wsName = "test"
If Not WorkSheetExists(wsName) Then Worksheets.Add().Name = wsName
If WorkSheetExists("test2") Then Worksheets(wsName).Move _
After:=ThisWorkbook.Worksheets("test2")
End Sub
Function WorkSheetExists(ByVal strName As String) As Boolean
On Error Resume Next
WorkSheetExists = Not ActiveWorkbook.Worksheets(strName) Is Nothing
End Function
* EDIT *
Updated function to specify which workbook should be tested
Function WorkSheetExists(ByVal SheetName As String, Optional ByRef WorkbookToTest As Workbook) As Boolean
On Error Resume Next
If WorkbookToTest Is Nothing Then Set WorkbookToTest = ThisWorkbook
WorkSheetExists = Not WorkbookToTest.Worksheets(SheetName) Is Nothing
End Function
A slightly different way of achieving this would be to create a dictionary of the sheet names.
You can then use the exists function to test whether the sheet exists or not
Dim sheetNames As Object
Dim ws As Worksheet
' Create and populate dictionary
Set sheetNames = CreateObject("Scripting.Dictionary")
For Each ws In ThisWorkbook.Sheets
sheetNames.Add ws.Name, ws.Index
Next ws
' Test if sheet exists
If Not sheetNames.Exists("test") Then
' If not add to workbook
ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets("test2")).Name = "test"
' add sheet to dictionary
sheetNames.Add "test", ThisWorkbook.Worksheets("test").Index
End If
Try this :
Function IsExists(name As String, Optional wb As Workbook) As Boolean
Dim sheet As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set sht = wb.Sheets(name)
On Error GoTo 0
IsExists = Not sheet Is Nothing
End Function
I have a pivot table in excel which looks like this:
Team Doc 1 Doc 2 Grand Total
Team A 13 12 25
Team B 8 7 15
Team C 32 5 37
Grand Total 53 24 77
I have already written a piece of VBA which will format any drill down sheets for printing (Workbook_NewSheet(ByVal Sh As Object)). However, as I'm trying to make this as user friendly as possible, I'd really like to be able to use vba to automatically rename any worksheets generated from the pivot table. However, I'm not sure how to do it as the content of each worksheet will be different depending on where the user clicks (i.e. if the user clicks in Team A Doc 1 Total then the sheet should be named 'Team A Doc 1' but if the user clicks in Grand Total row of Doc 2 then the sheet should be named 'Grand Total Doc 2') - I think there are something like 15 different worksheet names that could occur which is why I'm guessing the worksheet defaults to Sheet1! I'm thinking that a name could be generated by using offset to pick up the team name or the column name based on the active cell but I'm not really sure where to start so any suggestions/assistance would be greatly appreciated!
Thanks
I wish I could comment, but I can't yet, as I have not enough rep points! (Had to restart my account!)
I can suggest that you record a macro while you do a drill down on any given data point manually, and see how the recorded vba code looks. I would think from there you can configure your code to base the name of your worksheet on some element of the recorded code.
Since, I wanted this to be a comment, I will delete this if it's not helpful.
Update To Your Newly Posted Answer:
To check if the sheet already exists when a user drills down, you can check if the sheet existss after you get the sheet name to and if it does, select it, rather than creating a new one. Otherwise, you create it.
See this code for that:
Private Sub Workbook_NewSheet(ByVal sh As Object)
Application.ScreenUpdating = False
Dim shtCur As Worksheet
Set shtCur = ActiveSheet
Sheets("DQ Summary").Select
RN = ActiveCell.Row
CN = ActiveCell.Column
SheetName = Cells(RN, 2).Value & " - " & Cells(9, CN).Value
If SheetExists(SheetName) Then
Worksheets(SheetName).Select
Else
shtCur.Move _
After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
shtCur.Name = "SheetName"
End If
Application.ScreenUpdating = True
End Sub
Function SheetExists(wsName As String, Optional wb As Workbook = Nothing) As Boolean
SheetExists = False
Dim WS As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set WS = wb.Worksheets(wsName)
On Error GoTo 0
If Not WS Is Nothing Then SheetExists = True
End Function
I've managed to come up with something fairly workable:
Private Sub Workbook_NewSheet(ByVal sh As Object)
Dim RN, CN As Byte
Dim SheetName As String
Application.ScreenUpdating = False
ActiveSheet.Move _
After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
'Names the sheet according to the pivot drill
Sheets("DQ Summary").Select
RN = ActiveCell.Row
CN = ActiveCell.Column
SheetName = Cells(RN, 2).Value & " - " & Cells(9, CN).Value
'Identifies if worksheet already exists and replaces it if so.
Application.DisplayAlerts = False
On Error Resume Next
mySheetNameTest = Worksheets(SheetName).Name
If Err.Number = 0 Then
Worksheets(SheetName).Delete
MsgBox "The sheet named ''" & SheetName & "'' already exists but will be replaced."
Else
Err.Clear
End If
Application.DisplayAlerts = True
Sheets(ActiveWorkbook.Sheets.Count).Select
ActiveSheet.Name = SheetName
End Sub
Basically it's added onto the newsheet event - the macro adds the new sheet to the end of the workbook, goes to the pivot table sheet and identifies the column and row names of the active cell (since the column name and row name will always be static I can hard code this in) and then locates the newly added sheet (always at the end of the workbook) and renames it. Unfortunately there's an issue if a user tries to drill on the same data twice (can't have two worksheets with the same name) which I'm hoping to iron out.
Thanks for views/comments.
Edit: Updated code to work around worksheet duplication issue, seems to be doing the trick!
The script below loops through to create tabs and name the tab then it will place the tab name in cell B3. It's been working fine but now gives the catch all runtime error 1004. At the bottom of my script it renames the tab. This is where the error is happening. It's creating the tabs but fails to rename it. Can anyone please suggest another way to rename the tab in this script. The error is on Sheets(Name).Select.
Public Sub CreateTabs()
Sheets("TABlist").Select
' Determine how many Names are on Data sheet
FinalRow = Range("A65000").End(xlUp).Row
' Loop through each Name on the data sheet
For x = 1 To FinalRow
LastSheet = Sheets.Count
Sheets("TABlist").Select
Name = Range("A" & x).Value
' Make a copy of FocusAreas and move to end
Sheets("TABshell").Copy After:=Sheets(LastSheet)
' rename the sheet and put name in Cell B2
Sheets(LastSheet + 1).Name = Name
Sheets(Name).Select
Range("B3").Value = Name
Next x
End Sub
It is very important to write code that is robust. It shouldn't fail in any scenario. For example appropriate error handling should be done and variables declared.
I would recommend reading this.
Topic: To ‘Err’ is Human
Link: http://www.siddharthrout.com/2011/08/01/to-err-is-human/
Now back to your code. I have amended the code. Try this. I have also commented the code so you shouldn't have any difficulty understanding it :) Still if you do, just give a shout.
Code
Option Explicit
Public Sub CreateTabs()
Dim ws As Worksheet
Dim FinalRow As Long, x As Long, LastSheet As Long
Dim name As String
On Error GoTo Whoa
Application.ScreenUpdating = False
Set ws = Sheets("TABlist")
FinalRow = ws.Range("A" & Rows.Count).End(xlUp).Row
For x = 1 To FinalRow
LastSheet = Sheets.Count
'~~> Get the name for the new sheet
name = ws.Range("A" & x).Value
'~~> Check if you already have a sheet with that name or not
If Not SheetExists(name) Then
Sheets("TABshell").Copy After:=Sheets(LastSheet)
ActiveSheet.name = name
Range("B3").Value = name
End If
Next x
LetsContinue:
Application.ScreenUpdating = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
'~~> Function to check if sheet exists
Function SheetExists(wst As String) As Boolean
Dim oSheet As Worksheet
On Error Resume Next
Set oSheet = Sheets(wst)
On Error GoTo 0
If Not oSheet Is Nothing Then SheetExists = True
End Function
Each worksheet name in an Excel workbook needs to be unique.
As a quick fix to see what name is causing the error, try using this code and then check the sheet names against your list.
Public Sub CreateTabs()
On Error Resume Next
Sheets("TABlist").Select
' Determine how many Names are on Data sheet
FinalRow = Range("A65000").End(xlUp).Row
' Loop through each Name on the data sheet
For x = 1 To FinalRow
LastSheet = Sheets.Count
Sheets("TABlist").Select
Name = Range("A" & x).Value
' Make a copy of FocusAreas and move to end
Sheets("TABshell").Copy After:=Sheets(LastSheet)
' rename the sheet and put name in Cell B2
Sheets(LastSheet + 1).Name = Name
Sheets(Name).Select
Range("B3").Value = Name
Next x
On Error GoTo 0
End Sub
I got lost amid all the selects so I am not sure why your original code failed. I edited your question to make it more readable but only I can see the improvement until my edit it peer reviewed.
I have deleted all your select statements. Comments starting '## explain why I have made other changes.
Option Explicit
Public Sub CreateTabs()
Dim CrntRow As Long '## I like names I understand
Dim FinalRow As Long
Dim Name As String
' Determine how many Names are on Data sheet
'## Row.Count will work for any version of Excel
FinalRow = Sheets("TABlist").Cells(Rows.Count, "A").End(xlUp).Row
' Loop through each Name on the data sheet
For CrntRow = 1 To FinalRow
Name = Sheets("TABlist").Range("A" & CrntRow).Value
' Make a copy of FocusAreas and move to end
Sheets("TABshell").Copy After:=Sheets(Worksheets.Count)
' rename the sheet and put name in Cell B2
'## The copy will be the active sheet
With ActiveSheet
.Name = Name
.Range("B3").Value = Name
End With
Next CrntRow
End Sub