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!

 

[Jerry Sullivan]

Hi Serena,

The code examples earlier in this thread were intended to read the number formatting from the datasource range within the same workbook as the PivotTable.
That doesn't work with an external source like a data connection to an OLAP server.

If you are only modifying the headers, then you don't need to access the datasource and simpler code can be used like that shown below.

Paste into the ThisWorkBook Module of your workbook....

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

Paste into a Standard Code Module...

Option Explicit

Private m_NewWorksheet As Worksheet

Public Function ParseOLAPHeaders()
    Dim tblNew As ListObject


    Set m_NewWorksheet = ActiveSheet
    On Error Resume Next
    Set tblNew = m_NewWorksheet.ListObjects(1)
    On Error GoTo 0
    If tblNew Is Nothing Then
        '--This provides delay for the background query to complete and make the Table
        '--Modify as needed for your connection: IE: TimeSerial(0, 0, 3)= 3 seconds delay
        Application.OnTime Now + TimeSerial(0, 0, 3), "ParseNow"
    Else
        Call ParseNow
    End If
End Function

Private Function ParseNow()
'---replaces Table Headers with text inside last brackets of structured reference
'IE: replaces "[$Employee].[Employee Name]" with "Employee Name"

    Dim tblNew As ListObject
    Dim lcField As ListColumn
    Dim sHeader As String
    Dim vParts As Variant

    
    On Error Resume Next
    Set tblNew = m_NewWorksheet.ListObjects(1)
    On Error GoTo 0
    Set m_NewWorksheet = Nothing

    
    If tblNew Is Nothing Then Exit Function
    For Each lcField In tblNew.ListColumns
        sHeader = lcField.DataBodyRange(0).Text
        [COLOR="#0000CD"]vParts = Split(Replace(sHeader, "]", "["), "[")[/COLOR]
        If UBound(vParts) > 0 Then _
            lcField.DataBodyRange(0) = vParts(UBound(vParts) - 1)
    Next lcField
End Function

Instead of using a lookup table, the code will use the pattern of brackets to replace
"[$Employee].[Employee Name]" with "Employee Name"

If you want to replace "[$Employee].[Employee Name]" with "Name"
then replace the statement in Blue font above to read:

 vParts = Split(Replace(Replace(sHeader, " ", "["), "]", "["), "[")

This option should give the result you describe; however it is a bit more likely to have duplicates. In that case, Excel will rename the headers to make unique field names such as Name, Name2, Name3....

 

[ExcelSSAS]

Hi Jerry,

I don't know why but it seems like my drill down data is protected by default. I added a line of code below, and the renaming works! Thanks a lot!

Public Function ParseOLAPHeaders()
    Dim tblNew As ListObject


    Set m_NewWorksheet = ActiveSheet
    ActiveWorkbook.Unprotect
    On Error Resume Next
    Set tblNew = m_NewWorksheet.ListObjects(1)
    On Error GoTo 0
    If tblNew Is Nothing Then
        '--This provides delay for the background query to complete and make the Table
        '--Modify as needed for your connection: IE: TimeSerial(0, 0, 3)= 3 seconds delay
        Application.OnTime Now + TimeSerial(0, 0, 3), "ParseNow"
    Else
        Call ParseNow
    End If
End Function

If I have more formatting requirements, I might tweak the original codes a little bit since it provides more flexibility. Do you think that one is doable for OLAP connection?

But for now, it's just perfect.

Serena

 

[Jerry Sullivan]

Serena, Nice to hear that helped you.

It sounds like your workbook is setup to have protected structure. That would prevent you from adding any sheets to your workbook whether it be manually or through the drill down function. If you don't need to have the structure protected, you could unprotect it once and you wouldn't need that step in your code. If you do need to have the structure protected, then you should probably add a step to reset the protection at the end of this code.

Yes, the original code could be tweaked to work with OLAP or other external sources. The main thing to do would be to remove any parts that are trying to reference a datasource range. Just ask if you want some help with that.

 

[ExcelSSAS]

Hello Jerry,

I have a performance issue on running the drilldown on Excel. If I'm running the pivot table drill down in my office, everything works fine - the show details sheet displays the columns I limit and the renaming is fine. But when I run it at home office (my VPN works okay), the show details page comes up really really slow and when it finally comes up the number of rows is what I set up in the cube, but the renaming just does not work. It's still showing the unchanged column names, like "[$Employee].[Employee Name]". Do you have a thought on this? A network issue, or something else?

Thanks,
Serena

 

[Jerry Sullivan]

Serena,

You can adjust the delay before the headers are renamed at this part of the code.

        '--Modify as needed for your connection: IE: TimeSerial(0, 0, 3)= 3 seconds delay
        Application.OnTime Now + TimeSerial(0, 0, 3), "ParseNow"

Try adjusting the "3" to "10" or more.

For other data souces you can set Background Query = False in the Data Connection to have the code wait for the Query to complete before proceeding. That option isn't available for OLAP sources.

 

[ExcelSSAS]

Thank you for pointing this out!

 

[ExcelSSAS]

Jerry,

Instead of adjusting the delay time, is there a way to pause the application to call ParseNow before the drill down is complete on the new sheet? Since the time to complete the drill down really depends on the user's current network condition, it's hard to set a constant number.

I tried a loop, but the performance is not good.

Any suggestion?

 

[Jerry Sullivan]

I tried a loop, but the performance is not good.

I believe a loop won't work in this case (with or without DoEvents) as the Query import stops during that process. That's why I opted for Application.OnTime in my previous suggestion.

Through web search, I found the Application.CalculateUntilAsyncQueriesDone Method, which appears to be the magic bullet we were seeking.

The code can be greatly simplified using that Method. Replace all previous code with these two Procedures.

In ThisWorkBook Module:

Private Sub Workbook_NewSheet(ByVal sh As Object)
    Call ParseOLAPHeaders(sh)
End Sub

In a Standard Code Module:

Public Function ParseOLAPHeaders(sh As Object)
'---replaces Table Headers with text inside last brackets of structured reference
'IE: replaces "[$Employee].[Employee Name]" with "Employee Name"

    Dim tblNew As ListObject
    Dim lcField As ListColumn
    Dim sHeader As String
    Dim vParts As Variant

    
    '--will wait here until background query(ies) done.
    '--for OLAP which can't use QueryTable.Refresh Background:=False
    Application.CalculateUntilAsyncQueriesDone

    
    On Error Resume Next
    Set tblNew = sh.ListObjects(1)
    On Error GoTo 0

    
    If tblNew Is Nothing Then Exit Function
    For Each lcField In tblNew.ListColumns
        sHeader = lcField.DataBodyRange(0).Text
        vParts = Split(Replace(sHeader, "]", "["), "[")
        If UBound(vParts) > 0 Then _
            lcField.DataBodyRange(0) = vParts(UBound(vParts) - 1)
    Next lcField
End Function

 

[ExcelSSAS]

Awesome! It works perfect! Thank you Santa

 

[Jerry Sullivan]

Ho Ho Ho You are very welcome.