if sheet name is taken, add number at the end

Twollaston

Board Regular
Joined
May 24, 2019
Messages
233
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:

Some videos you may like

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,563
Office Version
365
Platform
Windows
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]
 

Twollaston

Board Regular
Joined
May 24, 2019
Messages
233
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
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,563
Office Version
365
Platform
Windows
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:

JugglerJAF

Active Member
Joined
Feb 17, 2002
Messages
265
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
 

mikerickson

MrExcel MVP
Joined
Jan 15, 2007
Messages
22,973
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
 

Twollaston

Board Regular
Joined
May 24, 2019
Messages
233
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?
 

Twollaston

Board Regular
Joined
May 24, 2019
Messages
233
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:

Twollaston

Board Regular
Joined
May 24, 2019
Messages
233
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
 

Watch MrExcel Video

Forum statistics

Threads
1,090,481
Messages
5,414,798
Members
403,542
Latest member
Phx007

This Week's Hot Topics

Top