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:
Rich (BB code):
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:
VBA Code:
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.
