none
VBA create Pivot table by double click on existing Pivot table field RRS feed

  • Question

  • Hi,

    Is there a way to create another pivot table based on double click on existing pivot table cell?

    Thanks

    Wilson

    Friday, November 21, 2014 5:44 AM

Answers

  • I don't know why you would do that, but here is an example:

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
      Dim oPivotField As Excel.PivotField
      Dim oPT As Excel.PivotTable
      Dim sCurrentPage As String
      Dim ws As Excel.Worksheet
      
      If Not pIsPivotTable(Target) Then Exit Sub
      
      Cancel = True
      
      ActiveSheet.Copy After:=ActiveSheet
      Set oPT = ActiveSheet.PivotTables(1)
      
      'Change the Pivot Table's layout, such as:
      sCurrentPage = ActiveCell
      Set oPivotField = ActiveCell.PivotField
      oPivotField.Orientation = xlPageField
      
      On Error Resume Next
      oPivotField.CurrentPage = sCurrentPage
      If Err.Number <> 0 Then MsgBox "Couldn't apply pivottable filter", vbExclamation
    End Sub
    
    Private Function pIsPivotTable(rng As Excel.Range) As Boolean
      Dim oPivot As Excel.PivotTable
      
      On Error Resume Next
      Set oPivot = rng.PivotTable
      On Error GoTo 0
      
      pIsPivotTable = Not (oPivot Is Nothing)
    End Function
    


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marked as answer by Wilson Wu Friday, November 28, 2014 6:32 AM
    Tuesday, November 25, 2014 7:57 PM

All replies

  • I don't know why you would do that, but here is an example:

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
      Dim oPivotField As Excel.PivotField
      Dim oPT As Excel.PivotTable
      Dim sCurrentPage As String
      Dim ws As Excel.Worksheet
      
      If Not pIsPivotTable(Target) Then Exit Sub
      
      Cancel = True
      
      ActiveSheet.Copy After:=ActiveSheet
      Set oPT = ActiveSheet.PivotTables(1)
      
      'Change the Pivot Table's layout, such as:
      sCurrentPage = ActiveCell
      Set oPivotField = ActiveCell.PivotField
      oPivotField.Orientation = xlPageField
      
      On Error Resume Next
      oPivotField.CurrentPage = sCurrentPage
      If Err.Number <> 0 Then MsgBox "Couldn't apply pivottable filter", vbExclamation
    End Sub
    
    Private Function pIsPivotTable(rng As Excel.Range) As Boolean
      Dim oPivot As Excel.PivotTable
      
      On Error Resume Next
      Set oPivot = rng.PivotTable
      On Error GoTo 0
      
      pIsPivotTable = Not (oPivot Is Nothing)
    End Function
    


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marked as answer by Wilson Wu Friday, November 28, 2014 6:32 AM
    Tuesday, November 25, 2014 7:57 PM
  • Hi Felipe Costa Gualberto,

    I want to do a drill-down report.  

    Thanks for your reply.

    Wilson

    Friday, November 28, 2014 6:32 AM