VBA Show detail pivot table row

AndreaJ

New Member
Joined
Jun 20, 2024
Messages
1
Office Version
  1. 365
Platform
  1. Windows
Hi

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 as the tables can have hundreds of rows.
1718873276201.png


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

Any help would be appreciated
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

Forum statistics

Threads
1,224,225
Messages
6,177,273
Members
452,765
Latest member
Erka Gizli

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