Two Pivot tables on different sheet using the same source and showing the detail of each row into separate sheets

battersn

New Member
Joined
Mar 14, 2016
Messages
1
I am very new to VBA and have searched extensively but unable to find a solution to my requirements. I have source data comprising of many columns of varying length daily. I require two pivot tables on different sheets and to show the detail of each row. I have data in the row and column fields however the row filed is what needs to change between the two pivot tables. I am unable to show the detail within a loop of each row using the grand total row column and also to address each pivot table.

Range("A2").Select

Dim PCache As Excel.PivotCache
Dim pvt As Excel.PivotTable

On Error Resume Next
Application.DisplayAlerts = False
Sheets("Pivot").Delete
On Error GoTo 0
Application.DisplayAlerts = True

Worksheets(1).Activate
'create pivot cache
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=1, SourceData:=Range("A1").CurrentRegion.Address)

'create 1st pivot table
Worksheets.Add
ActiveSheet.Name = "Pivot by Action Group Name"
ActiveWindow.DisplayGridlines = True
Set pvt = ActiveSheet.PivotTables.Add(PivotCache:=PCache, TableDestination:=Range("A1"), TableName:="PivotTable1")
Set pvt = ActiveSheet.PivotTables("PivotTable1")

'Off for Rows and Columns
pvt.ColumnGrand = True
pvt.RowGrand = True

'Select fields for PivotTable

ActiveWorkbook.ShowPivotTableFieldList = False
With pvt.PivotFields("Action Group Name")
.Orientation = xlRowField
.Position = 1
End With
With pvt.PivotFields("Request ID")
.Orientation = xlDataField
.Position = 1
End With

With pvt.PivotFields("Age Group")
.Orientation = xlColumnField
.Position = 1
End With

On Error Resume Next
With pvt.PivotFields("Age Group")
.PivotItems("100 Days Plus").Position = .PivotItems.Count
End With

ActiveSheet.PivotTables("PivotTable1").HasAutoFormat = False

ActiveSheet.PivotTables("PivotTable1").ShowTableStyleRowStripes = True


ActiveWindow.Zoom = 80

Cells.Select
With Selection.Font
.Name = "Calibri"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With

Set pvt = ActiveSheet.PivotTables(1)


pvt.TableRange1.Select

With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With


pvt.RowRange.Select

With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With


pvt.ColumnRange.Select
Selection.ColumnWidth = 12

Columns("A").Select
Selection.ColumnWidth = 40

Range("A1").Select




Dim C As Range
With ActiveSheet.PivotTables(1)
For Each C In .DataBodyRange.Resize(, 1)
C.ShowDetail = True
ActiveSheet.Name = [B2]
Next C
End With


Set pvt = Nothing




'create 2nd pivot table
Worksheets.Add
ActiveSheet.Name = "Pivot by Request Type"
ActiveWindow.DisplayGridlines = True
Set pvt = ActiveSheet.PivotTables.Add(PivotCache:=PCache, TableDestination:=Range("A1"), TableName:="PivotTable2")
Set pvt = ActiveSheet.PivotTables("PivotTable2")

'Off for Rows and Columns
pvt.ColumnGrand = True
pvt.RowGrand = True

'Select fields for PivotTable

ActiveWorkbook.ShowPivotTableFieldList = False
With pvt.PivotFields("Request Type")
.Orientation = xlRowField
.Position = 1
End With
With pvt.PivotFields("Request ID")
.Orientation = xlDataField
.Position = 1
End With

With pvt.PivotFields("Age Group")
.Orientation = xlColumnField
.Position = 1
End With

On Error Resume Next
With pvt.PivotFields("Age Group")
.PivotItems("100 Days Plus").Position = .PivotItems.Count
End With

ActiveSheet.PivotTables("PivotTable2").HasAutoFormat = False

ActiveSheet.PivotTables("PivotTable2").ShowTableStyleRowStripes = True


ActiveWindow.Zoom = 80

Cells.Select
With Selection.Font
.Name = "Calibri"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With

Set pvt = ActiveSheet.PivotTables(2)


pvt.TableRange1.Select

With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With


pvt.RowRange.Select

With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With


pvt.ColumnRange.Select
Selection.ColumnWidth = 12

Columns("A").Select
Selection.ColumnWidth = 40

Range("A1").Select

'Dim C As Range
With ActiveSheet.PivotTables(2)
For Each C In .DataBodyRange.Resize(, 1)
C.ShowDetail = True
ActiveSheet.Name = [B2]
Next C
End With
 

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.

Watch MrExcel Video

Forum statistics

Threads
1,122,437
Messages
5,596,112
Members
414,042
Latest member
Swiftkoala

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
Top