Macros to filter a OLAP pivot table

antaeusguy · Mar 8, 2010

Hi all,

I'm using a Pivot Table which is generated from OLAP. Certain fields are multi-dimension and can be "drilled down".

For example, the field "Customer" has "[Customer].[Customer group]" i.e. from Customer Group it can be drilled down to Customer.

I wish to create a macro that can filter a single entry.

I tried this code to choose the customer group AA - HAPPY HUISDIER

Sub Choose_Pivot()
With ActiveCell.PivotTable.PivotFields("[Customer].[Customer Group]")
For i = 1 To .PivotItems.Count
If Not .PivotItems(i).Name Like "AA - HAPPY HUISDIER" Then
.PivotItems(i).Visible = False
End If
Next i
End With
End Sub

When I run it, it stops where the red code above is. It gives the error message:

Run-time error '1004':

Unable to set the visible property of the PivotItem class.

But if I try this similiar code on a normal pivot table (not from OLAP), it works:

Sub Choose_Pivot()
With ActiveCell.PivotTable.PivotFields("Name")
For i = 1 To .PivotItems.Count
If Not .PivotItems(i).Name Like "Paul van Rijn" Then
.PivotItems(i).Visible = False
End If
Next i
End With
End Sub

Can anyone give me some guidance on solving this problem? Many thanks

Legacy 113902 · Mar 9, 2010

Hi a...guy,

Yep, sounds familiar to me.

What I've found out is, that writing a macro to manipulate an Pivot table is depending from the type of the underlying datasource (RDBMS, OLAP, etc.).

Writing a macro of a MS Access DB is pretty straight forward according to the Excel Help, but beware (*g*) of eg. MS OLAP! Here things can get a bit nasty (at least if your knowledge & expertise is as limited as mine is).

With (MS) OLAP I had to address and treat Pivot fields differently, depending of where these are placed (page/row/column filter, data fields).

When I'll be back at work, I'll post the code I've written to tackle this issue.

Cheers,
Sil68

antaeusguy · Mar 9, 2010

True, the macros are different for PivotTable depending on the source data.

Thank you for replying to my thread

Appreciate it much

I shall await for your reply.

Legacy 113902 · Mar 10, 2010

Hi,

Here it comes, as promised, my macro code.

Code:

''======================================================================
'' Update all Pivot Tables passed to the subroutine accordingly
''
'' Paramter:
''
''     pPivotTableArray ... multidimensional array structured like
''
''         [1] <Worksheet Name>, <Pivot Table Name>, array of (<Field Name>, <Field Value>)
''======================================================================
Private Sub MHUpdatePivotTableField(ByRef pPivotTableArray As Variant)

    '
    ' Local variable & constant declaration
    '
    Dim oWorksheet As Worksheet
    Dim oPivotTable As PivotTable
    Dim oPivotField As PivotField
    Dim oPivotItem As PivotItem
    Dim oRangeItem As Range
    
    Dim sWorksheetName As String
    Dim sPivotTableName As String
    Dim sFieldName As String
    Dim sFieldValue As Variant
    Dim aFieldValue() As Variant
    
    Dim bRC As Boolean
    Dim p, f, v As Long
    
    '
    ' Process each Pivot Table'
    '
    For p = LBound(pPivotTableArray) To UBound(pPivotTableArray)
    
        sWorksheetName = pPivotTableArray(p)(LBound(pPivotTableArray))
        sPivotTableName = pPivotTableArray(p)(LBound(pPivotTableArray) + 1)
        
        '
        ' Connect to the the Pivot Table
        '
        Set oWorksheet = Worksheets(sWorksheetName)
        Set oPivotTable = oWorksheet.PivotTables(sPivotTableName)
        
        '
        ' Prepare for updating the Pivot Table Fields
        '
        oPivotTable.ManualUpdate = True
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        
        '
        ' Update Pivot Table Fields
        '
        For f = LBound(pPivotTableArray(p)(LBound(pPivotTableArray) + 2)) To _
                UBound(pPivotTableArray(p)(LBound(pPivotTableArray) + 2))
            
            '
            ' Scan the Pivot Table Fields
            '
            sFieldName = pPivotTableArray(p)(LBound(pPivotTableArray) + 2)(f) _
                         (LBound(pPivotTableArray(p)(LBound(pPivotTableArray) + 2)(f)))
            sFieldName = MHPivotTableFieldCaptionToName(sWorksheetName, sPivotTableName, sFieldName)
            
            Set oPivotField = oPivotTable.PivotFields(sFieldName)
            oPivotField.ClearAllFilters
            oPivotField.EnableItemSelection = False
            
            '
            ' Set Pivot Table Filters
            '
            sFieldValue = pPivotTableArray(p)(LBound(pPivotTableArray) + 2)(f) _
                          (LBound(pPivotTableArray(p)(LBound(pPivotTableArray) + 2)(f)) + 1)
            
            '
            ' Range Object containing values
            '
            If (IsObject(sFieldValue)) Then
                v = 0
                
                For Each oRangeItem In sFieldValue.Item
                    ReDim aFieldValue(v + 1)
                    
                    aFieldValue(v) = MHPivotTablePageFieldValue(sWorksheetName, sPivotTableName, _
                                                                sFieldName, oRangeItem.Value)
                    v = v + 1
                Next
            
            '
            ' Array of values
            '
            ElseIf (IsArray(sFieldValue)) Then
                ReDim aFieldValue(UBound(sFieldValue))
                
                For v = LBound(sFieldValue) To UBound(sFieldValue)
                    If (LBound(sFieldValue) = 0) Then
                        aFieldValue(v) = MHPivotTablePageFieldValue(sWorksheetName, sPivotTableName, _
                                                                    sFieldName, sFieldValue(v))
                    Else
                        aFieldValue(v) = MHPivotTablePageFieldValue(sWorksheetName, sPivotTableName, _
                                                                    sFieldName, sFieldValue(v, 1))
                    End If
                Next v
                
            '
            ' Single value
            '
            Else
                ReDim aFieldValue(1)
                
                sFieldValue = MHPivotTablePageFieldValue(sWorksheetName, sPivotTableName, sFieldName, sFieldValue)
                aFieldValue(0) = sFieldValue
            End If
            
            bRC = MHPivotTableSetFilter(sWorksheetName, sPivotTableName, sFieldName, aFieldValue)
        Next f
        
        '
        ' Refresh Pivot Table
        '
        'oPivotTable.RefreshTable
        oPivotTable.ManualUpdate = False
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        
    Next p
        
End Sub

''======================================================================
'' Convert Pivot Table Field Caption into corresponding Name
''======================================================================
Private Function MHPivotTableFieldCaptionToName( _
    pWorksheetName As String, _
    pPivotTableName As String, _
    pFieldCaption As String) As String

    '
    ' Local variable & constant declaration
    '
    Dim oWorksheet As Worksheet
    Dim oPivotTable As PivotTable
    Dim oPivotField As PivotField
    Dim oPivotItem As PivotItem
    
    Dim sFieldName As String
    
    '
    ' Initialization
    '
    Set oWorksheet = Worksheets(pWorksheetName)
    Set oPivotTable = oWorksheet.PivotTables(pPivotTableName)
    
    sFieldName = vbNullString
    
    '
    ' Search for the field caption
    '
    For Each oPivotField In oPivotTable.PivotFields
        If (UCase(oPivotField.Caption) = UCase(pFieldCaption)) Then
            sFieldName = oPivotField.Name
        End If
    Next
    
    '
    ' Return Field Name
    '
    MHPivotTableFieldCaptionToName = sFieldName

End Function

''======================================================================
'' Retrieve Pivot Page Field value from OLAP/Cube data source
''======================================================================
Private Function MHPivotTablePageFieldValue( _
    pWorksheetName As String, _
    pPivotTableName As String, _
    pFieldName As String, _
    pSimpleFieldValue As Variant) As Variant

    '
    ' Local variable & constant declaration
    '
    Dim oWorksheet As Worksheet
    Dim oPivotTable As PivotTable
    Dim oPivotField As PivotField
    Dim oPivotItem As PivotItem
    
    Dim oTmpWorksheet As Worksheet
    Dim oTmpPivotCache As PivotCache
    Dim oTmpPivotTable As PivotTable
    Dim oTmpPivotField As PivotField
    Dim oTmpPivotItem As PivotItem
    Dim oTmpCubeField As CubeField
    
    Dim vFieldValue As Variant
    
    '
    ' Initialization
    '
    Set oWorksheet = Worksheets(pWorksheetName)
    Set oPivotTable = oWorksheet.PivotTables(pPivotTableName)
    Set oPivotField = oPivotTable.PivotFields(pFieldName)
    oPivotField.ClearAllFilters
    
    vFieldValue = Null
    
    '
    ' Retrieve field value
    '
    If (oPivotTable.PivotCache.OLAP) Then
        Select Case oPivotField.Orientation
        
            '
            ' Page, Row, Column Fields
            '
            Case xlPageField, xlRowField, xlColumnField
                
                '
                ' Create temporary items
                '
                Set oTmpWorksheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
                Set oTmpPivotCache = ActiveWorkbook.PivotCaches.Add(SourceType:=oPivotTable.PivotCache.SourceType)
                With oTmpPivotCache
                    .Connection = oPivotTable.PivotCache.Connection
                    .CommandType = oPivotTable.PivotCache.CommandType
                    .CommandText = oPivotTable.PivotCache.CommandText
                    .MaintainConnection = oPivotTable.PivotCache.MaintainConnection
                End With
                
                Set oTmpPivotTable = oTmpPivotCache.CreatePivotTable(Range("A1"), "TmpOLAPPivotTable")
                With oTmpPivotTable
                    .SmallGrid = False
                    .PivotCache.RefreshPeriod = 0
                    
                    With .CubeFields(Left(pFieldName, InStr(InStr(1, pFieldName, "].[") + 1, pFieldName, "].[")))
                        .Orientation = xlRowField
                        .Position = 1
                    End With
                    
                    For Each oTmpCubeField In .CubeFields
                        If (oTmpCubeField.DragToData) Then
                            With .CubeFields(oTmpCubeField.Name)
                                .Orientation = xlDataField
                                .Position = 1
                            End With
                            
                            Exit For
                        End If
                    Next
                End With

                '
                ' Retrieve pivot field value
                '
                Set oTmpPivotField = oTmpPivotTable.PivotFields(pFieldName)
                
                For Each oTmpPivotItem In oTmpPivotField.PivotItems
                    If (UCase(oTmpPivotItem.Caption) = UCase(pSimpleFieldValue)) Then
                        vFieldValue = oTmpPivotItem.Name
                        Exit For
                    End If
                Next
                
                '
                ' Delete temporary items
                '
                oTmpPivotTable.PivotSelect "", xlDataAndLabel, True
                Selection.ClearContents
                
                Application.DisplayAlerts = False
                oTmpWorksheet.Delete
                Application.DisplayAlerts = True
                
                oWorksheet.Activate
            
            '
            ' All other fields
            '
            Case Else
                vFieldValue = pSimpleFieldValue
        End Select
                
    Else
        vFieldValue = pSimpleFieldValue
    End If
    
    '
    ' Return Field Name
    '
    MHPivotTablePageFieldValue = vFieldValue

End Function

''======================================================================
'' Set Pivot Table Filters
''======================================================================
Private Function MHPivotTableSetFilter( _
    pWorksheetName As String, _
    pPivotTableName As String, _
    pFieldName As String, _
    pFieldValue As Variant) As Variant

    '
    ' Local variable & constant declaration
    '
    Dim oWorksheet As Worksheet
    Dim oPivotTable As PivotTable
    Dim oPivotField As PivotField
    Dim oPivotItem As PivotItem
    
    Dim bRC As Boolean
    Dim i As Long
    
    '
    ' Initialization
    '
    '
    ' Initialization
    '
    Set oWorksheet = Worksheets(pWorksheetName)
    Set oPivotTable = oWorksheet.PivotTables(pPivotTableName)
    Set oPivotField = oPivotTable.PivotFields(pFieldName)
    
    bRC = False

    '
    ' Dealing with a Cube data source
    '
    If (oPivotTable.PivotCache.OLAP) Then
        If (oPivotField.Orientation = xlPageField) Then
                oPivotField.CubeField.EnableMultiplePageItems = True
        End If
        
        If (IsArray(pFieldValue)) Then
            oPivotField.VisibleItemsList = pFieldValue
            bRC = True
        Else
            oPivotField.VisibleItemsList = Array(pFieldValue)
            bRC = True
        End If
        
    '
    ' Dealing with a non-Cube data source
    '
    Else
        Select Case oPivotField.Orientation
        
            '
            ' Page, Row, Column Fields
            '
            Case xlPageField, xlRowField, xlColumnField
                        If (oPivotField.Orientation = xlPageField) Then
                        oPivotField.EnableMultiplePageItems = True
                End If
                
                For Each oPivotItem In oPivotField.PivotItems
                    For i = LBound(pFieldValue) To UBound(pFieldValue)
                        oPivotItem.Visible = (oPivotItem.Caption = pFieldValue(i))
                        
                        If (oPivotItem.Visible) Then
                            bRC = True
                            Exit For
                        End If
                    Next i
                Next
            
            '
            ' All other fields
            '
            Case Else
                bRC = False
        End Select
    End If
    
    '
    ' Return function execution result
    '
    MHPivotTableSetFilter = bRC

End Function

I'm using these macro to automatically update quite a big Excel workbook based on some parameter set on a special parameter sheet.

After selecting the right entries (drop down lists via named ranges), I only click on a button which call my "master macro" (see example below).

Code:

'' $Id$
'' MHPropagateParameter
'' ====================
''
''     Propagate parameter (country name, company/legal entitiy) across
''     the currently open and active workbook and update all pivot tables
''     accordingly.
''
''     Usage:
''
''         MHPropagateParameter()
''
''     Important Notice:
''
''         The respective field values are accessible via a Named Range
''         ("CountryTarget" for the original/target country, and
''         "CountryTargetComparison" for the country to compare the former
''         one with), which consists of three pieces of information:
''
''            *) Name of the country in English (for Access-related tables
''               and common understanding)
''            *) Name of the country in German (for Cube-related tables)
''            *) Name of the legal entity/merchant
''
''     Procedure:
''
''         *) Go to each of the sheets containing a Pivot Table
''         *) Set Pivot field "COMPANY" (Cube)/"Company" (Access)
''            to "<Legal Entity>" and
''            "Country Name" (Cube)/"Country" (Access) to "<Country>"
''         *) Refresh Pivot Tables
''
'' Copyright (C) Martin HEIN (m#)/March+April 2009
''
''     $Log$
''

Public Sub MHPropagateParameter()
    
    '
    ' Local variable & constant declaration
    '
    Dim oWorksheet As Worksheet
    
    Dim oRangeTarget As Range
    Dim sCountryTargetEnglish As String
    Dim sCountryTargetGerman As String
    Dim sCompanyTarget As String
    
    Dim oRangeTargetComparison As Range
    Dim sCountryTargetComparisonEnglish As String
    Dim sCountryTargetComparisonGerman As String
    Dim sCompanyTargetComparison As String
    
    Dim oDateRangeTarget As Range
    
    Dim i As Long
    
    Dim bDocTest As Boolean
    
    '
    ' Initialization
    '
    bDocTest = True
    Set oWorksheet = Worksheets("Parameter")
    
    Set oRangeTarget = oWorksheet.Range("CountryTarget")
    sCountryTargetEnglish = oRangeTarget.Item(1).Value
    sCountryTargetGerman = oRangeTarget.Item(2).Value
    sCompanyTarget = oRangeTarget.Item(3).Value
    
    '
    ' Sheet "Test"
    ' "Test#01"..."Test#04" -> MS OLAP
    ' "Test#05"                         -> MS Access
    '
    If (bDocTest) Then
        Set oDateRangeTarget = oWorksheet.Range("DateRange")
        
        MHUpdatePivotTableField Array( _
            Array("Test #01", "Test#01", _
                  Array(Array("COMPANY", sCompanyTarget), Array("Country Name", sCountryTargetGerman), Array("Month", oDateRangeTarget), Array("Year", Array("CY2007", "CY2008", "CY2009"))) _
            ), _
            Array("Test #02", "Test#02", _
                  Array(Array("COMPANY", sCompanyTarget), Array("Country Name", sCountryTargetGerman), Array("Month", oDateRangeTarget)) _
            ), _
            Array("Test #03", "Test#03", _
                  Array(Array("COMPANY", sCompanyTarget), Array("Country Name", sCountryTargetGerman), Array("Month", oDateRangeTarget), Array("Year", Array("CY2007", "CY2008", "CY2009"))) _
            ), _
            Array("Test #04", "Test#04", _
                  Array(Array("COMPANY", sCompanyTarget), Array("Country Name", sCountryTargetGerman), Array("Month", oDateRangeTarget), Array("Year", Array("CY2007", "CY2008", "CY2009"))) _
            ), _
            Array("Test #05", "Test#05", _
                  Array(Array("Company", sCompanyTarget), Array("Country", sCountryTargetEnglish), Array("YearMonth", oDateRangeTarget), Array("Year", Array("2007", "2008", "2009"))) _
            ) _
        )
    End If

    '
    ' Return to original sheet ("Parameter") and re-calculate in order to update all cells
    '
    Application.Calculate
    oWorksheet.Activate

End Sub

''
'' end of file
''

Cheers,
Sil68

kuimengng · Feb 27, 2013

I had a similar problem and found the macro recorder to be very useful.

The code that filters all the pivot tables in my workbook:

Sub UpdatePivotTables()
Dim sDate As String
sDate = "[Date].[Fiscal Year - Fiscal Week - Fiscal Day].[Fiscal Week].&[2013-02-10T00:00:00]"

Dim wks As Worksheet
Dim pt As PivotTable

For Each wks In Worksheets
For Each pt In wks.PivotTables
pt.PivotFields( _
"[Date].[Fiscal Year - Fiscal Week - Fiscal Day].[Fiscal Year]"). _
VisibleItemsList = Array("")
pt.PivotFields( _
"[Date].[Fiscal Year - Fiscal Week - Fiscal Day].[Fiscal Week]"). _
VisibleItemsList = Array( _
sDate _
)
pt.PivotFields( _
"[Date].[Fiscal Year - Fiscal Week - Fiscal Day].[Fiscal Day]"). _
VisibleItemsList = Array("")
Next pt
Next wks

Set pt = Nothing
Set wks = Nothing
End Sub

Macros to filter a OLAP pivot table

antaeusguy

Board Regular

Excel Facts

Legacy 113902

Guest

antaeusguy

Board Regular

Legacy 113902

Guest

kuimengng

New Member

Similar threads

Forum statistics

Share this page

Macros to filter a OLAP pivot table

antaeusguy

Board Regular

Excel Facts

Legacy 113902

Guest

antaeusguy

Board Regular

Legacy 113902

Guest

kuimengng

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock