Pivot Table Drilldown - formatting, hidden columns, range instead of table

[PivotMeThis]

I find it highly annoying that Excel puts my data in a table with a bunch of filters when I drilldown in a pivot table. I always change it back to a range and make multiple changes to the formatting. If I have hidden columns in the base data they are no longer hidden in the worksheet which is created through the pivot table. It would be VERY nice if the new worksheet would be formatted like the base data...

Are there any advanced features I am missing to customize how the worksheet which is created by drilling down in a pivot table will appear? I have multiple workbooks that will be used by management and the data that is generated by the drilldown should appear formatted and ready for their use.

I thought about recording a macro to format everything and assigning it to a button but since the drilled down report will appear on a new worksheet I don't know where to put it or how to make it work. There could be multiple worksheets created by drilling down.

Thanks for any help out there.
I'm using 2010 - they are using 2007. Gotta love THAT!

 

[psfisk6320]

Hi Rhonda,

Recently I went looking for a solution to the problem of the drill down detail not retaining the number formatting of the source data.
There are a lot of threads on the web that describe the problem, but I couldn't find any solutions.

Here is some code that addresses the NumberFormat problem. As written, it doesn't convert the Table to a standard Worksheet Range; or copy other formatting like fill color.

If you like, those features could be added fairly easily though since the hard part was triggering the formatting when a new sheet was added for PivotTable drill down, but not triggering the formatting for a new sheet added by the user.

The set up requires copying code into three different code locations in the workbook, each identified below.

Paste into Sheet Code Module of Worksheet(s) with PivotTable(s)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
    Cancel As Boolean)
'---If user double-clicks in PivotTable data, assigns a string reference to
'---  the Pivot Table's SourceData Property to Public string sSourceDataR1C1
    On Error GoTo ResetPublicString
    With Target.PivotCell
        If .PivotCellType = xlPivotCellValue And _
            .PivotTable.PivotCache.SourceType = xlDatabase Then
                sSourceDataR1C1 = .PivotTable.SourceData
        End If
    End With
    Exit Sub
ResetPublicString:
    sSourceDataR1C1 = vbNullString
End Sub

Paste into ThisWorkbook Code Module

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Dim tblNew As ListObject
    On Error Resume Next
    
    Set tblNew = Cells(1).ListObject
    If tblNew Is Nothing Then Exit Sub
    Call Format_PT_Detail(tblNew)
    Set tblNew= Nothing
End Sub

Paste into a Standard Code Module

Public sSourceDataR1C1 As String

Public Function Format_PT_Detail(tblNew As ListObject)
'---Called by Workbook_NewSheet; Passes ShowDetai table object
'---Uses Pivot Table's SourceData Property stored in Public sSourceDataR1C1
'--- to read apply NumberFormats in first row of SourceData to tblNew
    Dim cSourceTopLeft As Range
    Dim lCol As Long
    Dim sSourceDataA1 As String
    
    If sSourceDataR1C1 = vbNullString Then Exit Function
    sSourceDataA1 = Application.ConvertFormula(sSourceDataR1C1, _
            xlR1C1, xlA1)
    Set cSourceTopLeft = Range(sSourceDataA1).Cells(1)
    With tblNew
        For lCol = 1 To .Range.Columns.Count
            .ListColumns(lCol).Range.NumberFormat = _
                cSourceTopLeft(2, lCol).NumberFormat
        Next lCol
    End With
    sSourceDataR1C1 = vbNullString
    cSourceTopLeft = Nothing
End Function

Just ask if you want any help extending the formatting features for your purposes.

Hi Jerry,

I am very pleased to have found what would appear to be a VBA solution to this interesting excel pivot table drilldown issue. However, after inserting the modules in this thread into my editior as per your directions, I am no longer able to make an existing 'ThisWorkbook' module, which automatically deletes a created drilldown sheet when a user activates another spreadsheet in the workbook. Here is the module that no longer functions, yet returns no error message:

Public mSheet As String

Private Sub Workbook_SheetBeforeDoubleClick( _
ByVal Sh As Object, ByVal Target As Range, _
Cancel As Boolean)

Dim curCell As String, ptname As String, a As Integer
Start:
If ActiveSheet.PivotTables.Count = 0 Then GoTo NoPT
On Error GoTo NoPT
If IsEmpty(Target) And ActiveCell.PivotField.Name <> "" Then
Cancel = True
GoTo NoPT
End If
mSheet = ActiveSheet.Name
curCell = ActiveCell.Address
ptname = Sh.Range(curCell).PivotTable
If ActiveSheet.PivotTables("PivotTable1").EnableDrilldown Then
Selection.ShowDetail = True
Rows("1:2").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
Selection.Value = _
"Remove this text to preserve this worksheet."
mSheet = ActiveSheet.Name
Else
a = MsgBox("Enable Drill Down is turned off. " & _
"would you like to enable it?", vbYesNo, _
"Drill Down Error...")
If a = vbYes Then
ActiveSheet.PivotTables("PivotTable1").EnableDrilldown = True
GoTo Start
Else
Cancel = True
End If
End If
NoPT:
On Error GoTo 0
End Sub

Your help is most appreciated,

Paul Fisk

 

[Jerry Sullivan]

Hi Paul and Welcome to the Board,

Try pasting the code below into your ThisWorkbook module.

Option Explicit

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
'---If user double-clicks in PivotTable data, assigns a string reference to
'---  the Pivot Table's SourceData Property to Public string sSourceDataR1C1


    On Error GoTo ResetPublicString


    With Target.PivotCell
        '--if double clicked cell is a Pivot Data field
        If .PivotCellType = xlPivotCellValue Then
            If Not .PivotTable.EnableDrilldown Then
                If vbYes = MsgBox("Enable Drill Down is turned off. " & _
                    "would you like to enable it?", vbYesNo, _
                    "Drill Down Error...") Then
                    .PivotTable.EnableDrilldown = True
                    .ShowDetail = True
                Else
                    Cancel = True
                    GoTo ResetPublicString
                End If
            End If
            If .PivotTable.PivotCache.SourceType = xlDatabase Then _
                sSourceDataR1C1 = .PivotTable.SourceData
        End If


    End With
    Exit Sub
ResetPublicString:
    sSourceDataR1C1 = vbNullString
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
'---If new sheet was created as drill down call formatting sub and
'   enter text in A1 that will be used by Sheet_Deactivate to flag deletion

    
    Dim tblNew As ListObject
    On Error Resume Next

    
    Set tblNew = Cells(1).ListObject
    If tblNew Is Nothing Then Exit Sub
    Call Format_PT_Detail(tblNew)

    
    Rows("1:2").Insert Shift:=xlDown
    Range("A1").Value = _
        "Remove this text to preserve this worksheet."
    Range("A1").Select
    Set tblNew = Nothing
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    If Sh.Range("A1") = _
        "Remove this text to preserve this worksheet." Then
        Application.DisplayAlerts = False
        Sh.Delete
        Application.DisplayAlerts = True
    End If
End Sub

Then add these procedures to a Standard module from Post #2 of this thread...

Public sSourceDataR1C1 As String

Public Function Format_PT_Detail(tblNew As ListObject)
'------see Post #2

Optionally, incorporate the added features in posts #6 and #8.

 

[arenus]

Hi out there

I found this thread after some time research online and not founding a right solution for my problem.

My setup:
I connect trough Excel 2010 to a SSAS 2008 R2 Cube to retreive data (what works) and then display some financial data.

My problem:
To see which bookings are contained in the totals listed in my earnings-statement, I need the drilldown. But in the newly created workbook I have too much attributes that I don't need and the ones I really need are hidden somewhere in the middle or at the end of the attributes list.

What I need:
Is there an easy possibility to change the sort-order or just to remove the (in my eyes) unnecessary attributes?

I saw the incredible macro above, that can nearly do everything for formatting and hope, you can help my as well.

Thank you in advance and best regards
Pius

 

[Jerry Sullivan]

Hi Pius,

The code at this link is probably a better example to use if you are only needing to delete rows of your drill down data.
http://www.mrexcel.com/forum/excel-...contains-n-remove-duplicates.html#post3485806

You'll need to define what you consider "unnecessary attributes" in a way that Excel can interpret that. The code at that link will delete all rows that cause a criteria formula to evaluate to "True".
You just need to compose a formula that evaluates to True for records with "unnecessary attributes".

 

[arenus]

Thank you Jerry, that would definitely help me!

But instead of delete would also just hide be perfect...

I hope I can adapt the script if not I would post my upcomming problems in the other thread!

best regards

 

[redjayhawk11]

Hi Jerry,

I've been studying this thread for several weeks and have never been able to get it to work for me. I'm pretty sure I've followed all of the steps you listed out but for some reason still can't get it to work for me. I could attach a mock up workbook but didn't see the ability to attach anything other than a link, image or video (all web items)? I'm sure it's probably difficult to see what I'm missing without seeing my work.

My goal is to have the ability to delete columns in a new sheet that opens when someone doubleclicks into a pivot table. The data set I'm working with has 261 columns but only 15 are needed when doubleclicking in the pivot table.

Thanks in advance and sorry to be jumping in the middle of an old thread.

Rhonda,

Here's an attempt to allow you or anyone else to adapt this with minimal editing of the VBA code.
To do that, I'd suggest the use of a three-column range within your workbook to define any special formatting.

This is loosely based on your list; however I've modified it a bit to show Delete and Color.

In this example, the range is on Sheet "Drill Down" which could be a hidden sheet if you prefer.

Sheet Drill Down

*	A	B	C
*	*
*

<TBODY>
[TD="bgcolor: #cacaca"]1
[/TD]
[TD="bgcolor: #00ffff, align: left"]Data Source Header
[/TD]
[TD="bgcolor: #00ffff, align: left"]Property or Method
[/TD]
[TD="bgcolor: #00ffff, align: left"]Value
[/TD]

[TD="bgcolor: #cacaca"]2
[/TD]
[TD="align: left"]Letting Date
[/TD]
[TD="align: left"]Hidden
[/TD]
[TD="align: left"]TRUE
[/TD]

[TD="bgcolor: #cacaca"]3
[/TD]
[TD="align: left"]Designer
[/TD]

[TD="bgcolor: #cacaca"]4
[/TD]
[TD="align: left"]Office
[/TD]
[TD="align: left"]Hidden
[/TD]
[TD="align: left"]TRUE
[/TD]

[TD="bgcolor: #cacaca"]5
[/TD]
[TD="align: left"]Contractor
[/TD]
[TD="align: left"]Hidden
[/TD]
[TD="align: left"]TRUE
[/TD]

[TD="bgcolor: #cacaca"]6
[/TD]
[TD="align: left"]Project Awarded Amount
[/TD]
[TD="align: left"]NumberFormat
[/TD]
[TD="align: left"]"$#,##0.00"
[/TD]

[TD="bgcolor: #cacaca"]7
[/TD]
[TD="align: left"]Project Authorized Amount
[/TD]
[TD="align: left"]Delete
[/TD]

[TD="bgcolor: #cacaca"]8
[/TD]
[TD="align: left"]Awarded Quantity
[/TD]
[TD="align: left"]NumberFormat
[/TD]
[TD="align: left"]"0.000"
[/TD]

[TD="bgcolor: #cacaca"]9
[/TD]
[TD="align: left"]Awarded Quantity
[/TD]
[TD="align: left"]Color
[/TD]
[TD="align: left"]10092543
[/TD]

[TD="bgcolor: #cacaca"]10
[/TD]
[TD="align: left"]From Quantity
[/TD]
[TD="align: left"]Hidden
[/TD]
[TD="align: left"]TRUE
[/TD]

</TBODY>

Excel tables to the web >> Excel Jeanie HTML 4

The order of the fields on the list doesn't matter and you don't need to list the fields that do not need special formatting (like "Designer").

You could list all your fields if it helps you- the code will make no change to a field if its second column is blank.

The only other setup needed is to replace function Format_PT_Detail with this version,
and paste the function Format_Table shown below into the same Standard Module as Format_PT_Detail.

Public Function Format_PT_Detail(tblNew As ListObject)
'---Called by Workbook_NewSheet; Passes ShowDetai table object
'---Uses Pivot Table's SourceData Property stored in Public sSourceDataR1C1
'--- to read apply NumberFormats in first row of SourceData to tblNew
    Dim cSourceTopLeft As Range
    Dim lCol As Long
    Dim sSourceDataA1 As String
    
    If sSourceDataR1C1 = vbNullString Then Exit Function
    sSourceDataA1 = Application.ConvertFormula(sSourceDataR1C1, _
            xlR1C1, xlA1)
    Set cSourceTopLeft = Range(sSourceDataA1).Cells(1)
    With tblNew
        For lCol = 1 To .Range.Columns.Count
            .ListColumns(lCol).Range.NumberFormat = _
                cSourceTopLeft(2, lCol).NumberFormat
        Next lCol
        'Optional to do additional formatting
        Call Format_Table(tbl:=tblNew, _
            rFieldFormats:=Sheets("Drill Down").Range("A1").CurrentRegion)
        tblNew.Unlist   'Optional: Converts Table to Standard Range
        .Cells(1).Select
    End With
    sSourceDataR1C1 = vbNullString
    cSourceTopLeft = Nothing
End Function

Private Function Format_Table(tbl As ListObject, rFieldFormats As Range)
'---Uses the information in rFieldFormats to format the Table
'   3 columns in rFieldFormats define: Field | Property | New Property Value
'   Example Net Sales | NumberFormat | "$#,##0.00"
    
    Dim c As Range
    Dim sField As String, sFieldRef As String
    Dim sProperty As String, sNewValue As String
    On Error Resume Next
    
    For Each c In rFieldFormats.Resize(, 1)
        sField = c(1, 1)
        sProperty = c(1, 2)
        sNewValue = c(1, 3)
        sNewValue = Replace(sNewValue, """", "") 'remove any quotes
        
        sFieldRef = tbl.Name & "[" & sField & "]"
        With Range(sFieldRef)
            Select Case sProperty
                Case "Color"
                    .Interior.Color = sNewValue
                Case "Delete"
                    .EntireColumn.Delete
                Case "Font"
                    .Font = sNewValue
                Case "Hidden"
                    .EntireColumn.Hidden = sNewValue
                Case "NumberFormat"
                    .NumberFormat = sNewValue
                Case ""
                  '---No formatting changes
                Case "Property or Method"
                  '---Skip rFieldFormats Header Row
                Case Else
                    MsgBox sProperty & " is not a defined Property " & _
                        "or Method in Function Format_Table"
            End Select
       End With
    Next c
    Set c = Nothing
End Function

These two functions are unchanged and should be pasted where noted in in Post #2 of this thread.
Workbook_NewSheet
Worksheet_BeforeDoubleClick

Please let me know if this does what you wanted, or if you want any help adapting it for your use.

 

[Jerry Sullivan]

Hi redjayhawk11,

This forum doesn't support attachments- when necessary people either post to a sharing site like Box.com or exchange email addresses through a Private Message (PM).

You're welcome to do either of those.

 

[Jerry Sullivan]

redjayhawk11, Thanks for sending your example file.

There were a few thing setup incorrectly, but the more significant obstacle is that when that file generates DrillDown detail, it places the data in a standard Range instead of an Excel Table (a VBA ListObject). I've seen this once before and I believe it only occurs in files that were converted from .xls to .xlsm format. Is that the case with your example file? Refreshing the Pivot restores the expected xl2007 and later behavior of generating an Excel Table.

I'll modify the code to work with either scenario and post that here.

One clarification... you noted that only want the detail to show 15 of the 261 fields. If you are not needing the code to modify the formatting of specific fields, then what you want could be done more simply than the approach developed for Rhonda at the beginning of this thread. I'd suggest an interface in which you list the 15 fields to be displayed in a Named Range in your workbook then the code would delete all other fields. Would that work for you, or do you need the additional formatting?

 

[redjayhawk11]

Jerry...thanks for taking time to help me out.

I'm really just looking for the ability to remove columns that have data not relevant to the end user who would be drilling into the pivot table. The ability to format would be low on the priority list but a nice feature to have. I was just trying to implement what was done with "drill down" sheet based on what was posted in the previous posts and thought it would allow me to delete/hide columns.

If possible I'd rather have the drilldown data be in table format instead of standard range. But my data set is in a workbook that started as .xls and later saved as .xlsm

Please let me know if you have any other questions I can answer.

Thank again.

 

[Jerry Sullivan]

I'm really just looking for the ability to remove columns that have data not relevant to the end user who would be drilling into the pivot table. The ability to format would be low on the priority list but a nice feature to have. I was just trying to implement what was done with "drill down" sheet based on what was posted in the previous posts and thought it would allow me to delete/hide columns.

If possible I'd rather have the drilldown data be in table format instead of standard range. But my data set is in a workbook that started as .xls and later saved as .xlsm

Here's some code you can try that handles the removal of unwanted fields, but doesn't include the custom formatting in the earlier examples in this thread. Remove any code from the previous examples above from your workbook.

To set this up, first place a list of fields that fields you want to keep in the drilldown detail in a one-column wide range, then add a workbook Name for that range. The code assumes that range is named "lstFieldsToKeep". You can name that something else provided you change the code to match.

Paste this code in the ThisWorkbook module...

Private Sub Workbook_NewSheet(ByVal Sh As Object)
 Dim rDetail As Range, rFieldsToKeep As Range
 
 Set rDetail = Cells(1).CurrentRegion
 '--if new sheet is blank, rDetail.Count will be 1
 If rDetail.Count < 2 Then Exit Sub
 
 On Error Resume Next
 Set rFieldsToKeep = Range("lstFieldsToKeep")
 On Error GoTo 0
 If Err.Number <> 0 Then
   MsgBox "Named range: lstFieldsToKeep not found"
   Exit Sub
 End If

 '--Calls procedure to remove all fields
   '  except those listed in rFieldsToKeep
 Call KeepFields(rExistingData:=rDetail, _
   rFieldsToKeep:=rFieldsToKeep)

End Sub

Paste this code in a Standard Code Module...

Public Sub KeepFields(ByVal rExistingData As Range, _
      rFieldsToKeep As Range)
'--This procedure removes all fields from rExistingData range
'  except those listed in rFieldsToKeep
      
 Dim vExistingData As Variant, vExistingFields As Variant
 Dim vFieldsToKeep As Variant, vResults As Variant
 Dim vMatchCol As Variant
 Dim lCol As Long, lRow As Long, lWriteCol
   
 '--validate input ranges
 If rFieldsToKeep.Columns.Count > 1 Then
   MsgBox "Fields to Keep range must be 1 column wide."
   Exit Sub
 End If
 
 '--read range values into arrays
 vExistingData = rExistingData.Value
 vFieldsToKeep = rFieldsToKeep.Value
 vExistingFields = Application.Index(rExistingData, 1, 0).Value
 If Not IsArray(vFieldsToKeep) Then _
   vFieldsToKeep = Array(vFieldsToKeep)
   
 ReDim vResults(1 To UBound(vExistingData, 1), _
   1 To UBound(vFieldsToKeep, 1))
 
 '--find each matching field and copy entire column of values
 For lCol = 1 To UBound(vFieldsToKeep, 1)
      vMatchCol = Application.Match(vFieldsToKeep(lCol, 1), vExistingFields, 0)
      If IsNumeric(vMatchCol) Then
         lWriteCol = lWriteCol + 1
         For lRow = 1 To UBound(vExistingData, 1)
            vResults(lRow, lWriteCol) = vExistingData(lRow, lCol)
         Next lRow
      End If
 Next lCol
 
 '--clear existing data then write results
 With rExistingData
   .Clear
   If lWriteCol > 0 Then
      .Resize(, lWriteCol).Value = vResults
      '--convert to table (optional)
      ActiveSheet.ListObjects.Add SourceType:=xlSrcRange, _
         Source:=.Range("A1").CurrentRegion, _
         XlListObjectHasHeaders:=xlYes
   End If
 End With
 
End Sub