if sheet name is taken, add number at the end

Twollaston

Board Regular
Joined
May 24, 2019
Messages
241
Hey everyone,

I have a macro that creates a data table on one sheet and a pivot table on another sheet, and the problem I'm having is that i can only run the macro once and then I have to change the sheet names to do it again. I'm trying to make it so that if the sheet name is taken, then it will add a 1,2,3,4,5 etc... at the end, depending on how many times it's run.

If anyone can help me ammend my code that would be greatly appreciated.

I was hoping to do this for both sheet "Data" and "Summary"

Code:
Sub PivotTableCreation()


'Copies Query To New Sheet


ActiveSheet.Cells.Select
Application.CutCopyMode = False
    Selection.Copy
    Sheets.Add.Name = "Data"
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, transpose:=False


' Creates Pivot Table With Dynamic Range


    Rows("1:4").Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select


'Dynamic Range Table
ActiveSheet.ListObjects.Add(xlSrcRange, Range([A1].End(xlDown), [A1].End(xlToRight)), , xlYes).Name _
= "NewTable"


'Table Style
ActiveSheet.ListObjects("NewTable").TableStyle = "TableStyleMedium17"




'New Sheet For Pivot Table
Sheets.Add.Name = "Summary"


'Pivot Table Creation
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="NewTable", Version:=xlPivotTableVersion14).CreatePivotTable TableDestination _
:="Summary!R3C1", TableName:="InsertNameHere", DefaultVersion:=xlPivotTableVersion14






End Sub
 
Last edited:

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Try this:

Code:
[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] PivotTableCreation()


[I][COLOR=seagreen]'Copies Query To New Sheet[/COLOR][/I]


ActiveSheet.Cells.Select
Application.CutCopyMode = [COLOR=Royalblue]False[/COLOR]
    Selection.Copy
[I][COLOR=seagreen]''    Sheets.Add.Name = "Data"[/COLOR][/I]
    [COLOR=Royalblue]Call[/COLOR] addSheet([COLOR=brown]"Data"[/COLOR])
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=[COLOR=Royalblue]False[/COLOR], Transpose:=[COLOR=Royalblue]False[/COLOR]


[I][COLOR=seagreen]' Creates Pivot Table With Dynamic Range[/COLOR][/I]


    Rows([COLOR=brown]"1:4"[/COLOR]).[COLOR=Royalblue]Select[/COLOR]
    Selection.Delete Shift:=xlUp
    Range([COLOR=brown]"A1"[/COLOR]).[COLOR=Royalblue]Select[/COLOR]


[I][COLOR=seagreen]'Dynamic Range Table[/COLOR][/I]
ActiveSheet.ListObjects.Add(xlSrcRange, Range([A1].[COLOR=Royalblue]End[/COLOR](xlDown), [A1].[COLOR=Royalblue]End[/COLOR](xlToRight)), , xlYes).Name _
= [COLOR=brown]"NewTable"[/COLOR]


[I][COLOR=seagreen]'Table Style[/COLOR][/I]
ActiveSheet.ListObjects([COLOR=brown]"NewTable"[/COLOR]).TableStyle = [COLOR=brown]"TableStyleMedium17"[/COLOR]




[I][COLOR=seagreen]'New Sheet For Pivot Table[/COLOR][/I]
[I][COLOR=seagreen]''Sheets.Add.Name = "Summary"[/COLOR][/I]
[COLOR=Royalblue]Call[/COLOR] addSheet([COLOR=brown]"Summary"[/COLOR])

[I][COLOR=seagreen]'Pivot Table Creation[/COLOR][/I]
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=[COLOR=brown]"NewTable"[/COLOR], Version:=xlPivotTableVersion14).CreatePivotTable TableDestination _
:=[COLOR=brown]"Summary!R3C1"[/COLOR], TableName:=[COLOR=brown]"InsertNameHere"[/COLOR], DefaultVersion:=xlPivotTableVersion14


[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR]


[COLOR=Royalblue]Private[/COLOR] [COLOR=Royalblue]Sub[/COLOR] addSheet(sName [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR])
[COLOR=Royalblue]Dim[/COLOR] ws [COLOR=Royalblue]As[/COLOR] Worksheet, z [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], x
[COLOR=Royalblue]Dim[/COLOR] nm [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR], q [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR]
[COLOR=Royalblue]If[/COLOR] Evaluate([COLOR=brown]"ISREF('"[/COLOR] & sName & [COLOR=brown]"'!A1)"[/COLOR]) [COLOR=Royalblue]Then[/COLOR]

     [COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] ws [COLOR=Royalblue]In[/COLOR] ActiveWorkbook.Worksheets
        nm = UCase(ws.Name): q = UCase(sName)
            [COLOR=Royalblue]If[/COLOR] nm [COLOR=Royalblue]Like[/COLOR] q & [COLOR=brown]"*"[/COLOR] [COLOR=Royalblue]And[/COLOR] Len(nm) > Len(q) [COLOR=Royalblue]Then[/COLOR]
                x = Replace(nm, q, [COLOR=brown]""[/COLOR])
                [COLOR=Royalblue]If[/COLOR] IsNumeric(x) [COLOR=Royalblue]Then[/COLOR]
                    [COLOR=Royalblue]If[/COLOR] z < x [COLOR=Royalblue]Then[/COLOR] z = x
                [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
            [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    [COLOR=Royalblue]Next[/COLOR]
    Sheets.Add.Name = sName & z + [COLOR=crimson]1[/COLOR]
[COLOR=Royalblue]Else[/COLOR]
Sheets.Add.Name = sName
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]
 
Upvote 0
I got a "Runtime error '1004': Applicatoin-defined or object-defined error

I tried to update the name to sName, but it's not working for me. Tried some different iterations, but i couldn't figure it out. Thanks for sharing that though, it works for the data sheet, just not the summary
 
Upvote 0
it works for the data sheet, just not the summary
Not sure why it works for the data sheet, but not the summary.
When you run the code what is the active sheet?

Which line is highlighted in yellow when the code stops?

Edit:
And for the moment, let's try something simple first, run this code and tell me what happen.

Code:
Sub try9()
Call addSheet("Data")
Call addSheet("Summary")

End Sub
 
Last edited:
Upvote 0
I've very quickly knocked this up for adding a sheet called "data" with an incrementing number. You should be able to replicate and edit this to add additional "summary" sheets as well.

Code:
Sub add_incrementing_worksheet_name()
'count number of worksheets already in workbook with required name (data or data_)
    data_sheet_counter = 0
    For Each ws In ActiveWorkbook.Worksheets
        If UCase(ws.Name) = "DATA" Or UCase(Left(ws.Name, 5)) = "DATA_" Then
            data_sheet_counter = data_sheet_counter + 1
        End If
    Next ws
'generate name to use
    If data_sheet_counter > 0 Then
        my_new_sheet_name = "data_" & data_sheet_counter + 1
    End If
'add new worksheet at end of workbook and name it
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = my_new_sheet_name
End Sub
 
Upvote 0
You might use this UDF. Given a seed name, it will return the next indexed name with that root.

If there is no sheet named "MySheet", NextSheetName("MySheet") will return "MySheet"
If there is a sheet named "MySheet", it will return "MySheet(2)", unless that exists in which case it will return "MySheet(3)", etc.

Note that the seedName can be in a sequence, i.e. NextSheetName("MySheet(2)") will return "MySheet(3)" if "MySheet(2)" already exits.

Code like
Code:
Worksheets.Add.Name = NextSheetName("MySheet")
will add a sheet in the "mySheet" series of worksheets.

Code:
Function NextSheetName(ByVal seedName As String, Optional wb As Workbook) As String
    Dim strRoot As String, Index As Long
    If wb Is Nothing Then Set wb = ThisWorkbook
    
    If SheetExists(seedName, wb) Then
        If seedName Like "*?(*)" Then
            strRoot = Split(seedName, "(")(0)
            Index = Val(Split(seedName, "(")(1))
        Else
            strRoot = seedName
            Index = 1
        End If
        NextSheetName = NextSheetName(strRoot & "(" & (Index + 1) & ")", wb)
    Else
        NextSheetName = seedName
    End If
End Function

Function SheetExists(sheetName As String, Optional wb As Workbook) As Boolean
    If wb Is Nothing Then Set wb = ThisWorkbook
    On Error Resume Next
    SheetExists = LCase(wb.Sheets(sheetName).Name) = LCase(sheetName)
    On Error GoTo 0
End Function
 
Upvote 0
I've very quickly knocked this up for adding a sheet called "data" with an incrementing number. You should be able to replicate and edit this to add additional "summary" sheets as well.

Code:
Sub add_incrementing_worksheet_name()
'count number of worksheets already in workbook with required name (data or data_)
    data_sheet_counter = 0
    For Each ws In ActiveWorkbook.Worksheets
        If UCase(ws.Name) = "DATA" Or UCase(Left(ws.Name, 5)) = "DATA_" Then
            data_sheet_counter = data_sheet_counter + 1
        End If
    Next ws
'generate name to use
    If data_sheet_counter > 0 Then
        my_new_sheet_name = "data_" & data_sheet_counter + 1
    End If
'add new worksheet at end of workbook and name it
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = my_new_sheet_name
End Sub

Having the same problem as with the previous one, i get an error that references:
Sheets.Add(After:=Sheets(Sheets.Count)).Name = my_new_sheet_name
Any ideas?
 
Upvote 0
Not sure why it works for the data sheet, but not the summary.
When you run the code what is the active sheet?

Which line is highlighted in yellow when the code stops?

Edit:
And for the moment, let's try something simple first, run this code and tell me what happen.

Code:
Sub try9()
Call addSheet("Data")
Call addSheet("Summary")

End Sub

Yes that is working fine, it's creating both sheets for me with the correct number at the end, even if I keep doing it over and over

The line I get the error on is:
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="NewTable", Version:=xlPivotTableVersion14).CreatePivotTable TableDestination:="Summary!R3C1", TableName:="InsertNameHere", DefaultVersion:=xlPivotTableVersion14

Because that page already has a pivot table in that spot, so i was trying to think of a way to get the dynamic sheet name
i tried grabbing the sName variable from the other sub AddSheet(sName As String)
I'm not sure how to do that though, i tried making it a public sub, I tried a bunch of stuff, but I think I'm just making a simple mistake
 
Last edited:
Upvote 0
Okay Everyone, I was able to get it to work. Sorry for my extreme newbyness, the little things always mess me up!

Thanks everyone who replied and helped me on here, I couldn't have done it without you guys!

For anyone having trouble with something similar you can use the below code:


Rich (BB code):
Sub PivotTableCreation()




'Copies Query To New Sheet




ActiveSheet.Cells.Select
Application.CutCopyMode = False
    Selection.Copy
''    Sheets.Add.Name = "Data"
    Call addSheet("Data")
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, transpose:=False




' Creates Pivot Table With Dynamic Range




    Rows("1:4").Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select




'Dynamic Range Table
ActiveSheet.ListObjects.Add(xlSrcRange, Range([A1].End(xlDown), [A1].End(xlToRight)), , xlYes).Name _
= "NewTable"




'Table Style
ActiveSheet.ListObjects("NewTable").TableStyle = "TableStyleMedium17"








'New Sheet For Pivot Table
''Sheets.Add.Name = "Summary"
Call addSheet("Summary")
SheetName = ActiveSheet.Name




'Pivot Table Creation
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="NewTable", Version:=xlPivotTableVersion14).CreatePivotTable TableDestination:= _
"'" & SheetName & "'!R3C1", TableName:="InsertNameHere", DefaultVersion:=xlPivotTableVersion14




End Sub




Private Sub addSheet(sName As String)
Dim ws As Worksheet, z As Long, x
Dim nm As String, q As String
If Evaluate("ISREF('" & sName & "'!A1)") Then


     For Each ws In ActiveWorkbook.Worksheets
        nm = UCase(ws.Name): q = UCase(sName)
            If nm Like q & "*" And Len(nm) > Len(q) Then
                x = Replace(nm, q, "")
                If IsNumeric(x) Then
                    If z < x Then z = x
                End If
            End If
    Next
    Sheets.Add.Name = sName & z + 1
Else
Sheets.Add.Name = sName
End If


End Sub
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

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