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
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