I am trying to show the detail on each of these rows (except the blank and grand total row) & rename the sheet to the row label without double clicking each row total as the normal table has hundreds of rows.
Condensed example of pivot table
Any help would be appreciated.
I have tried the coding below but it returns the details of column 2023/001, I would like to know what changes I need to make so it will show the detail of the grand total column on the far right, which as each month is added is in a variable position
Sub ShowDrillDownByRow()
--creates separate drilldown sheet for each
row in the first pivotTable of the active sheet
attempts to rename new sheets with rowitem name
if there is only one rowfield.
Dim bDrillDownMode As Boolean
Dim lNRowsToDrill As Long
Dim pvt As PivotTable
Dim rCell As Range, rActiveCell As Range
Dim sActiveSheetName As String
On Error Resume Next
Set pvt = ActiveSheet.PivotTables(1)
If Err.Number <> 0 Then
MsgBox "No PivotTable found on Active Sheet"
Exit Sub
End If
On Error GoTo 0
'--save to reset before exit
Set rActiveCell = ActiveCell
Application.ScreenUpdating = False
With pvt
'--drill down must be enabled
bDrillDownMode = .EnableDrilldown
.EnableDrilldown = True
With .DataBodyRange
'--don't drill down grand total row
lNRowsToDrill = .Rows.Count + pvt.ColumnGrand
For Each rCell In .Resize(lNRowsToDrill, 1)
rCell.ShowDetail = True
'--rename new sheets if only one rowfield
' could be modified to handle more rowfields
If pvt.RowFields.Count = 1 Then
'--err handler in case of invalid sheet name
' or sheetname already in use
On Error Resume Next
ActiveSheet.Name = rCell.PivotCell.RowItems(1)
On Error GoTo 0
End If
Next rCell
End With
End With
ExitProc:
pvt.EnableDrilldown = bDrillDownMode
Application.Goto rActiveCell
Application.ScreenUpdating = True
End Sub
AndreaJ is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.