RE: Pivot table creation in existing sheet- VBA issues

[Keerthi@21]

Hi All,

I need an help to create pivot table in same existing sheet. I have tried creating macros using recording and as well as on the dynamic way. However, I face runtime error at pivot creation part (Attached error images).pivot.JPG

Pivot table in existing sheet creation support required- explained below:

1)In my workbook I have multiple sheets where pivot table should always be created in second sheet - which will be the source data for pivot(sheet will be second sheet after Main data sheet) - Attached the source dump for your reference.


2)one more help required here is- name of sheet changes based on item name(Sheet name starts with space followed by name of item Eg: Item-Pencil). Also, one or two sheets will be hidden in workbook.


Hence I am struggling while creating pivot cache part. In my code, i am trying calling the sheet name with sheet index, while creating pivot sheet and facing the run-time error in below line when i step through the code.

Set myPivotTable = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Sheet3.Name & "!" & mySourceData).CreatePivotTable(TableDestination:=Sheet3.Name & "!" & myDestinationRange, TableName:="PivotTableExistingSheet")



kindly validate and provide your help. Thanks for your support in advance!

[p45cal]

Change to:

Set myPivotTable = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="'" & Sheet3.Name & "'!" & mySourceData).CreatePivotTable(TableDestination:="'" & Sheet3.Name & "'!" & myDestinationRange), TableName:="PivotTableExistingSheet")

[Keerthi@21]

Hi p45cal,

I get the syntax error when i checked replaced your code and not allowing me to step through the code.

Attachment 27354

Please help out

Set myPivotTable = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="'" & Sheet3.Name & "'!" & mySourceData).CreatePivotTable(TableDestination:="'" & Sheet3.Name & "'!" & myDestinationRange), TableName:="PivotTableExistingSheet")

[p45cal]

Invalid attachment specified.

[Keerthi@21]

Hi,

PFA the attachment.

syntax.jpg

[p45cal]

Well I tested it here before posting - attach the modified file here.

[Keerthi@21]

Hi p45cal,

I could no view or download your file. Please reshare it.

[p45cal]

I don't have a file to share; I'm asking you to share yours, the one which includes my suggested amendment.

[Keerthi@21]

Hi p45cal,

Please find the attachment - modified file with your line of code.

Sorry for the confusion.

[p45cal]

an extra parenthesis crept in:

Set myPivotTable = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="'" & Sheet3.Name & "'!" & mySourceData).CreatePivotTable(TableDestination:="'" & Sheet3.Name & "'!" & myDestinationRange, TableName:="PivotTableExistingSheet")

[Paul_Hossler]

Here's something to consider -- my guess as to where you wanted to get to

Some of that code was way more complicated than needed

Option Explicit


Sub createPivotTableExistingSheet()
    Dim rMainData As Range
    Dim wsPT As Worksheet, wsItem As Worksheet
    Dim myPivotTable As PivotTable
    Dim ptItem As PivotItem
 
    Set rMainData = MainData.Cells(1, 1).CurrentRegion      '   Note - Using code name for WS "Main Data"
 
    Set wsPT = AddSheet("PT")
 
     Set myPivotTable = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
        SourceData:=rMainData).CreatePivotTable(TableDestination:=wsPT.Cells(1, 1), TableName:="PivotTableExistingSheet")
 
    With myPivotTable
        .PivotFields("Item").Orientation = xlPageField
        .PivotFields("OrderDate").Orientation = xlRowField
        .PivotFields("Region").Orientation = xlRowField
        .PivotFields("Rep").Orientation = xlRowField
        .PivotFields("Units").Orientation = xlRowField
        .PivotFields("Unit Cost").Orientation = xlRowField
        With .PivotFields("Total")
            .Orientation = xlDataField
            .Position = 1
            .Function = xlSum
            .NumberFormat = "#,##0.00"
        End With
    
        .RowAxisLayout xlTabularRow
        
        .PivotFields("OrderDate").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .PivotFields("Region").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .PivotFields("Rep").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .PivotFields("Item").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .PivotFields("Units").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .PivotFields("Unit Cost").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .PivotFields("Total").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        
        .ColumnGrand = False
        .RowGrand = False
        
        .PivotFields("OrderDate").AutoSort xlAscending, "OrderDate"
        .PivotFields("Region").AutoSort xlAscending, "Region"
        .PivotFields("Rep").AutoSort xlAscending, "Rep"
        
        For Each ptItem In .PivotFields("Item").PivotItems
            .PivotFields("Item").ClearAllFilters
            .PivotFields("Item").CurrentPage = ptItem.Value
        
            Set wsItem = AddSheet(ptItem.Value)
                    
            .TableRange1.Copy
            wsItem.Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            wsItem.Cells(1, 1).CurrentRegion.Font.Bold = False
            wsItem.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
        Next
    End With
End Sub




Private Function AddSheet(S As String) As Worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets(S).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Call ThisWorkbook.Worksheets.Add(MainData)
    ActiveSheet.Name = S
    Set AddSheet = ActiveSheet


End Function

[Keerthi@21]

HI p45cal,

Thanks for the updated code shared by you. it works fine.

Also, I need your support again here -> I need to create the same pivot table for each sheets after the first sheet of current workbook.

Example: Let's say if i have 5 -sheets after first sheet, then macro should create the pivot table in each sheet till the no. of. sheets found in that workbook. Please help out.

Thanks for your help in advance.

[Keerthi@21]

Hi Paul_Hossler,

Thanks for your code. I will check and revert back.

Adding one point here- i want the macros to create pivot in existing sheets of macro file, i don't want to create sheet and pivot table to be created there.

If i have 5 sheets in my file, then macro should create 4 sheets each -> pivot table with same pivot fields and values.

One more condition macro should start picking up post first sheet i.e., from second sheet till N- sheets it should create pivot table. Please help me if this is possible


Thanks for your help and support.

[Paul_Hossler]

All do-able

BUT what is it that you really want to end up with?

Looking at your Sample attachment

Capture.JPG

I GUESSED that you were looking for a worksheet for each Item

Now I really don't understand

Do you mean that you want the pivot table source in MainData to be built by combining data from "Item-Pen" and "Item-Pencil, etc.?

Or

Do you want 4 pivot tables, one pne each Item worksheet and using the data on that sheet?

[Keerthi@21]

Hi Paul_Hossler,

My current macro creates the pivot table only for one sheet Item - Pencil using P45cal piece of code it works fine for this sheet.

I need some more additional feature like for each sheet, pivot tables to be created as you stated below:


Do you want 4 pivot tables, one pen each Item worksheet and using the data on that sheet - yes. IF my workbook have 5 sheets, then 5 pivot tables tobe created using the data on the sheet with same pivot fields as per current macro.

Item -column field

Region- Row field

Total - Values field (as sum)

two conditions:
Sheet name will vary and change hence we need to refer in this way sheet1 or sheet index.

macro should start creating pivot table from second sheet i.e, except Main Data, it should create pivot for all sheets using the data on that sheet.

[p45cal]

I'm confused too with that last attachement; for exmple 9/27/20 West Sorvino Pen 76 1.99 151.24 appears on 3 sheets.

[Paul_Hossler]

Try this, but I have to say that I don't see where you're going with this

Option Explicit


Sub createPivotTables()
    Dim rData As Range
    Dim wsPT As Worksheet, wsItem As Worksheet
    Dim myPivotTable As PivotTable
 
    For Each wsItem In ActiveWorkbook.Worksheets
        If wsItem.Name = "Main Data" Then GoTo NextSheet    '   space in from of tab name
        If wsItem.Visible <> xlSheetVisible Then GoTo NextSheet '   sheet2 is hidden
 
        Set rData = wsItem.Cells(1, 1).CurrentRegion
    
        Set myPivotTable = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
            SourceData:=rData).CreatePivotTable(TableDestination:=wsItem.Cells(1, 1).Offset(0, rData.Columns.Count + 2))
 
        With wsItem.PivotTables(1)
            .PivotFields("OrderDate").Orientation = xlRowField
            .PivotFields("Region").Orientation = xlRowField
            .PivotFields("Rep").Orientation = xlRowField
            .PivotFields("Item").Orientation = xlRowField
            .PivotFields("Units").Orientation = xlRowField
            .PivotFields("Unit Cost").Orientation = xlRowField
                With .PivotFields("Total")
                    .Orientation = xlDataField
                    .Position = 1
                    .Function = xlSum
                    .NumberFormat = "#,##0.00"
                End With
        
            .RowAxisLayout xlTabularRow
            
            .PivotFields("OrderDate").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("Region").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("Rep").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("Item").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("Units").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("Unit Cost").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("Total").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            
            .ColumnGrand = False
            .RowGrand = False
            
            .PivotFields("OrderDate").AutoSort xlAscending, "OrderDate"
            .PivotFields("Region").AutoSort xlAscending, "Region"
            .PivotFields("Rep").AutoSort xlAscending, "Rep"
        End With
    
NextSheet:
    Next
End Sub

[Keerthi@21]

Hi Paul_Hossler,

Thanks for your code and it works fine. But can i ask for some changes in this code, i just need only simple pivot table to created in each sheet except Main Data without blank and grand totals to be shown at end of pivot table as shown below:
mypivot.PNG

As per your work it works fine in each sheet, pivot created. can you please bring it to start from column J and row 3. Also, please remove the highlighted pivot fields from pivot :
Paul_pivot.jpg

Only these fields are required to view in pivot table:
Item -column field

Region- Row field

Total - Values field (as sum)

Please don't worry about the data within each sheets. it is for testing purpose.


This is an condition: First sheet and other sheets will have space in the beginning of the sheet name.

Please help out.

Thanks for your support in advance.

[Paul_Hossler]

Option Explicit


Sub createPivotTables()
    Dim rData As Range
    Dim wsItem As Worksheet
    Dim myPivotTable As PivotTable
    Dim i As Long
 
    For Each wsItem In ActiveWorkbook.Worksheets
        With wsItem
        
            If .Name = " Main Data" Then GoTo NextSheet         '   space in from of tab name
            If .Visible <> xlSheetVisible Then GoTo NextSheet   '   sheet2 is hidden
 
            Set rData = .Cells(1, 1).CurrentRegion
    
            If .PivotTables.Count > 0 Then
                For i = .PivotTables.Count To 1 Step -1
                    .PivotTables(i).TableRange1.EntireColumn.Delete
                Next i
            End If
    
    
            Set myPivotTable = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
                SourceData:=rData).CreatePivotTable(TableDestination:=.Cells(3, 10))
 
            With .PivotTables(1)
                .PivotFields("Region").Orientation = xlRowField
                .PivotFields("Item").Orientation = xlColumnField
                With .PivotFields("Total")
                    .Orientation = xlDataField
                    .Position = 1
                    .Function = xlSum
                    .NumberFormat = "#,##0.00"
                End With
            
                .RowAxisLayout xlTabularRow
                
                .PivotFields("Region").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
                .PivotFields("Item").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
                .PivotFields("Total").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
                
                .ColumnGrand = False
                .RowGrand = False
                
                .PivotFields("Region").AutoSort xlAscending, "Region"
                            
                On Error Resume Next
                .PivotFields("Region").PivotItems("(blank)").Visible = False
                .PivotFields("Item").PivotItems("(blank)").Visible = False
                On Error GoTo 0
            End With
        End With
NextSheet:
    Next
End Sub

[Keerthi@21]

Hi Paul_Hossler,


Thanks for your updated code. I have tested in my system as well and perfectly pivot tables are created as per my request.


This absolutely works fine . Thank you so much for your patience and help .


@p45cal - Thank you so much for your help and too