pivot tables and showdetail/drill down

[charlie1105]

Hi all,

just wondering if anyone knows if it's possible to get a drill down of multiple cells from a pivot table into the same sheet easily, as when I use

    Range("BE23:BE26").Select
    Selection.ShowDetail = True

it only pulls out the first drill down (i.e. the equivalent of double clicking BE23)

I'm sure there's a work around I can write which performs each drill down separately then combine the sheets, but it's probably going to end up fairly longwinded!

If anyone knows of an easier way, please let me know

Cheers

Charlie

 

[ghynes]

Here is how that can be accomplished.

Step 1
Place this code in your workbook module. To easily access your workbook module, find the little Excel workbook icon near the upper left corner of your workbook window, usually just to the left of the File menu option. Right click on that icon, left click on View Code, and paste the following procedure into the large white area that is the workbook module.

Private Sub Workbook_NewSheet(ByVal Sh As Object) 
Call DrillDownDefault 
End Sub

Step 2
While in the VBE, place this in the worksheet module of the sheet that holds the pivot table:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
Dim PTT As Integer 
On Error Resume Next 
PTT = Target.PivotCell.PivotCellType 
If Err.Number = 1004 Then 
Err.Clear 
Else 
CS = ActiveSheet.Name 
End If 
End Sub

Step 3
Also while in the VBE, place this in a standard VBA module:

Public CS As String 

Sub DrillDownDefault() 
With Application 
.ScreenUpdating = False 
Dim LR As Long 
LR = Sheets(CS).Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 2 
Range("A1").CurrentRegion.Copy Sheets(CS).Cells(LR, 1) 
.DisplayAlerts = False 
ActiveSheet.Delete 
.DisplayAlerts = True 
Sheets(CS).Select 
.ScreenUpdating = True 
End With 
End Sub

Step 4
Press Alt+Q to return to the worksheet.


Now, as you double-click the Data section of the pivot table, that target cell's drill-down dataset will be stacked vertically in order of the drill-downs, below and on the same sheet as the pivot table.

Another cool feature:
If, after creating a drill-down data set, yo no longer want to see it on that sheet, simply double click any cell in that data set's range and it will be deleted from the sheet.

anyone know how to edit the code to remove current selection (after you double click it) and add new selection (when you double click it in its place) ?

 

[maek]

Tom
Thanks for that wonderful code http://www.mrexcel.com/forum/showthread.php?t=289427 to drill-down PT data on the same sheet, and the double click feature is great! However, I figured a problem, although not directly related to the code. The problem Im having is I cannot add a new sheet to my workbook ever since using the code. I tried to use the code on a fresh workbook without any macros apart from the code above, but still cannot add a new sheet. Your help is very much appreciated. Thanks

 

[Tom Urtis]

Replied to this link:
http://www.mrexcel.com/forum/showthread.php?t=354980

 

[jajamb]

Hey,

I want to create something similar, but my data comes from an external source like a data connection to an OLAP server.

Can this be achieved, with this kind of data source?

- Jajamb

 

[BSaraf]

Hi Tom,

Many thank for posting the above solution.
I had a similar requirement and your solution helped me to achieve it.
However, there is one challenge that is being faced in implementing this code, though may be very simple but I have struggled all day trying to fix it with no luck.

Issue faced -
After implementing the above 3 Steps, there is huge amount of screen flickering occurring while code is run, which I am unable to fix.
The Application.ScreenUpdating doesn't seem to work in this case.

Any help to remove the flickering/screen-update would be much appreciated.

Thanks in advance!

Regards
Bisesh

 

[Tom Urtis]

Hello Bisesh - -

Unfortunately, I cannot replicate the screen flickering you describe, because it does not happen to me. In fact, even without ScreenUpdating set to False, some minimal screen flickering may occur but not at the level of a huge amount as you described. Just guessing, it may have to do with causes outside the realm of the VBA code, such as the system you are working in to run the code, or the nature of the data such as if it comes from some external source or is on a network or shared drive, or maybe the pivot table itself if there are calculations in it. I just cannot say, but maybe someone else reading this may have an idea. If you find the cause(s), please post back with what you found.

 

[JamesAs]

Here is how that can be accomplished.

Step 1
Place this code in your workbook module. To easily access your workbook module, find the little Excel workbook icon near the upper left corner of your workbook window, usually just to the left of the File menu option. Right click on that icon, left click on View Code, and paste the following procedure into the large white area that is the workbook module.

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Call DrillDownDefault
End Sub

Step 2
While in the VBE, place this in the worksheet module of the sheet that holds the pivot table:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim PTT As Integer
On Error Resume Next
PTT = Target.PivotCell.PivotCellType
If Err.Number = 1004 Then
Err.Clear
Else
CS = ActiveSheet.Name
End If
End Sub

Step 3
Also while in the VBE, place this in a standard VBA module:

Public CS As String

Sub DrillDownDefault()
With Application
.ScreenUpdating = False
Dim LR As Long
LR = Sheets(CS).Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 2
Range("A1").CurrentRegion.Copy Sheets(CS).Cells(LR, 1)
.DisplayAlerts = False
ActiveSheet.Delete
.DisplayAlerts = True
Sheets(CS).Select
.ScreenUpdating = True
End With
End Sub

Step 4
Press Alt+Q to return to the worksheet.


Now, as you double-click the Data section of the pivot table, that target cell's drill-down dataset will be stacked vertically in order of the drill-downs, below and on the same sheet as the pivot table.

Another cool feature:
If, after creating a drill-down data set, yo no longer want to see it on that sheet, simply double click any cell in that data set's range and it will be deleted from the sheet.

Hi Tom, I’m using 2016 and have just tried the code from above and it works to a point but when double clicking on the added tables beneath the pivot they do not delete? Any ideas? Also as the users will be filtering through various parts of the table could change be developed where if a filter (or indeed the contents of the pivot) is applied then it deletes the tables beneath? Anyway hope your still active as I’d love to use this excellent piece of work
James

 

[Tom Urtis]

Hello James - -

I've posted many variations of this topic because over time (this thread goes back 13 years) there have been a mixture of ad hoc requests, which is fine.

So as to your first question, here is the code you need, which will delete drill down records when they are double-clicked upon. NOTE: Be sure to modify the code where I have Sheet1 as the VBA codename sheet as to where the pivot table actually resides.

In the workbook module:

Private Sub Workbook_NewSheet(ByVal Sh As Object)
'Declare a variable for the next available row to stack a recordset.
Dim NextRow As Long

With Application
'Turn off ScreenUpdating.
.ScreenUpdating = False

'Determine the next available row and copy the recordset to it.
With Sheet1
NextRow = _
.Cells.Find(What:="*", After:=.Range("A1"), _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 2
Range("A1").CurrentRegion.Copy .Cells(NextRow, 1)
End With

'Delete the active sheet that you will never see, which is the
'sheet that got produced by double-clicking a pivot table cell.
'Set DisplayAlerts to False so you are not prompted to confirm
'the deletion of this new sheet.
.DisplayAlerts = False
ActiveSheet.Delete
'Turn back on DisplayAlerts.
.DisplayAlerts = True

'Turn ScreenUpdating back on.
.ScreenUpdating = True
End With
End Sub

In the worksheet module where you will be double-clicking to delete recordsets:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'Turn off ScreenUpdating.
Application.ScreenUpdating = False

'Declare a variable to determine if the cell you double-clicked
' • belongs to a pivot table,
' • or has data in a recordset you want to delete,
' • or is some other cell having nothing to do with pivot tables.
Dim PivotTargetType As Integer
On Error Resume Next
'Is the cell that was double-clicked a pivot table cell?
PivotTargetType = Target.PivotCell.PivotCellType
'If not, clear the error.
If Err.Number = 1004 Then
Err.Clear
'If so, then if there is data in the cell...
If Not IsEmpty(Target) Then
'If the row of the cell that was double-clicked is not in the
'explanatory text at the top of the sheet in this example..
If Target.Row > Range("A1").CurrentRegion.Rows.Count + 1 Then
'Avoid going into Edit mode from the double-click.
Cancel = True
'Release filters that may be present, in order to show all rows.
'The error bypass is if no to-be-deleted recordsets are being filtered.
On Error Resume Next
ActiveSheet.ShowAllData
Err.Clear
'Delete the rows belonging to the CurrentRegion of the double-clicked recordset.
With Target.CurrentRegion
.Resize(.Rows.Count + 1).EntireRow.Delete
End With
End If
End If
End If

'Turn ScreenUpdating back on.
Application.ScreenUpdating = True
End Sub

Note that there is to be no macro in a standard module for this. It's the above 2 events (workbook and worksheet) and that's it as far as the code goes. I just tested it again and am sure it works as advertised.

Regarding your other question, it sounds like a change event tied to the pivot table itself (when you wrote "if a filter (or indeed the contents of the pivot) is applied") can trigger a macro to simply clear the cells below the pivot table if that's what you mean. Certainly do-able but you'd want to have a confirmation message box to first appear, so someone's hard work at creating those dozens of recordsets doesn't go to waste by clearing them all in one fell swoop or any inadvertent change.

Editing this only to call attention to the board's admins regarding how the green font color tags appear when clicking on their icon and palette color as directed in the local menu bar to change a particular text's color, unless I did it wrong which is always a possibility. I did it the same way for this red font color which looks right, with no such visible code tags.

 

[JamesAs]

Tom, many thanks for responding so quickly! I'll give this a try and see how I get on.
Reference the question on removing the tables beneath the Pivot if the contents change (due to a filter/change), yes a msg box confirming deletion would be sensible. Is this something you can do at all???Pretty Please?? sorry im a complete novice at VBA, however i'm trying to pick it as I go along. Thanks

 

[JamesAs]

Hi Tom, Struggling with this. What do I keep from the earlier code that places the table beneath the Pivot Table? Within VB I have the following tree structure, maybe I'm not understanding how your describing the locations.
-VBA Project (Build etc workbook name)
- Microsoft Excel Objects
- Sheet2 (Pivot)
- Sheet3 (Table)
-ThisWorkbook
- Modules
- Module1