Skip to Content
Technical Articles
Author's profile photo Vadim Kalinin

BPC NW 10: VBA function to get dimension members list by Property value

Updated on 2019.06.18: Code corrected to support properties like PARENTx, performance improved.

Updated on 2019.06.14: Code corrected to support proper case for short ID.

Updated on 2019.06.13: Late binding to work on EPM or AO.

Decided to share simple code to get list of dimension members having some property value. The standard EPM API function is missing for this task. The code can be easily changed to support multiple properties for selection

The following references are required in Tools -> References:

Parameters are described in the code:

Option Explicit

'References to Microsoft Scripting Runtime required

Public Function GetMembersByProperty(strConn As String, _
    strDim As String, strProperty As String, _
    strPropValue As String, blnFullMember As Boolean) As String()
'Parameters: strConn - Connection string, strDim - Dimension name,
'strProperty - Property name, strPropValue - Property value,
'blnFullMember - True: result as full name [DIMNAME].[PARENTHx].[MEMBERID]
'False: result as MEMBERID
'Result: Array of strings. If first element is "" then nothing found
'and second element - error reason

    Dim objAddIn As COMAddIn
    Dim epm As Object
    Dim AOComAdd As Object
    Dim blnEPMInstalled As Boolean

    Dim strDims() As String
    Dim strProps() As String
    Dim blnExistFlag As Boolean
    Dim blnPARENTH As Boolean
    Dim lngDimHierPref As Long
    Dim strDimHierPref As String
    Dim strMem() As String
    Dim strMemID As String
    Dim dctMembers As New Scripting.Dictionary
    Dim varPropVal As Variant
    Dim varMemFull As Variant
    Dim lngTemp As Long
    Dim lngTemp1 As Long

On Error GoTo Err
    'Universal code to get FPMXLClient for standalone EPM or AO
    For Each objAddIn In Application.COMAddIns
        If objAddIn.progID = "FPMXLClient.Connect" Then
            Set epm = objAddIn.Object
            blnEPMInstalled = True
            Exit For
        ElseIf objAddIn.progID = "SapExcelAddIn" Then
            Set AOComAdd = objAddIn.Object
            Set epm = AOComAdd.GetPlugin("com.sap.epm.FPMXLClient")
            blnEPMInstalled = True
            Exit For
        End If
    Next objAddIn
    
    If Not blnEPMInstalled Then
        ReDim strMem(0 To 1)
        strMem(0) = ""
        strMem(1) = "NO_EPM"
        GetMembersByProperty = strMem
        Exit Function
    End If

    'Check if Dimension strDim exists
    strDims = epm.GetDimensionList(strConn)
    For lngTemp = 0 To UBound(strDims)
        If strDims(lngTemp) = strDim Then
            blnExistFlag = True
        End If
    Next lngTemp
    
    Erase strDims
    
    If Not blnExistFlag Then
        ReDim strMem(0 To 1)
        strMem(0) = ""
        strMem(1) = "NO_DIMENSION"
        GetMembersByProperty = strMem
        Exit Function
    End If
    
    'Check if Property strProperty exists for Dimension strDim
    blnExistFlag = False
    strProps = epm.GetPropertyList(strConn, strDim)
    For lngTemp = 0 To UBound(strProps)
        If strProps(lngTemp) = strProperty Then
            blnExistFlag = True
        End If
    Next lngTemp
    
    Erase strProps
    
    If Not blnExistFlag Then
        ReDim strMem(0 To 1)
        strMem(0) = ""
        strMem(1) = "NO_PROPERTY"
        GetMembersByProperty = strMem
        Exit Function
    End If
    
    'Test for Properties like PARENTHx
    If strProperty Like "PARENTH*" Then
        blnPARENTH = True
        lngDimHierPref = Len(strDim) + Len(strProperty) + 5 'Len of "[DIMNAME].[PARENTHx]"
        strDimHierPref = "[" & strDim & "].[" & strProperty 'String like "[DIMNAME].[PARENTHx"
    End If

    'Get full list of dimension members with duplicates due to possible multiple hierarchies
    strMem = epm.GetHierarchyMembers(strConn, "", strDim)
    For lngTemp = 0 To UBound(strMem)
        lngTemp1 = InStrRev(strMem(lngTemp), "[")
        strMemID = Mid(strMem(lngTemp), lngTemp1 + 1, Len(strMem(lngTemp)) - lngTemp1 - 1)
        'Add only unique member ID's (ID in upper case!)
        If Not dctMembers.Exists(strMemID) Then
            dctMembers.Add strMemID, strMem(lngTemp)
        End If
    Next lngTemp
    
    'Loop dictionary with unique member list and read Property value
    lngTemp = 0
    For Each varMemFull In dctMembers.Items
        'Check member proprty value
        'Corrected based on Evgeniy Samardak comment!
        'Application.Run("EPMMemberProperty" instead of epm.GetPropertyValue(
        If blnPARENTH Then
            'For PARENTx properties
            strMemID = strDimHierPref & Mid(varMemFull, lngDimHierPref)
            varPropVal = Application.Run("EPMMemberProperty", "", strMemID, strProperty)
            If varPropVal = "The member requested does not exist in the specified hierarchy." Or _
                varPropVal = 0 Then
                    varPropVal = ""
            End If
        Else
            'For other properties
            varPropVal = Application.Run("EPMMemberProperty", "", CStr(varMemFull), strProperty)
        End If
        If varPropVal = strPropValue Then
            If blnFullMember Then
                strMem(lngTemp) = CStr(varMemFull)
            Else
                'Get ID in proper case
                strMem(lngTemp) = CStr(Application.Run("EPMMemberProperty", "", CStr(varMemFull), "ID"))
            End If
            lngTemp = lngTemp + 1
        End If
    Next varMemFull
    
    Set dctMembers = Nothing
    
    If lngTemp = 0 Then
        ReDim strMem(0 To 1)
        strMem(0) = ""
        strMem(1) = "NO_MATCH"
    Else
        ReDim Preserve strMem(0 To lngTemp - 1)
    End If
    
    GetMembersByProperty = strMem
    Exit Function
Err:
    ReDim strMem(0 To 1)
    strMem(0) = ""
    If Err.Number = -1073479167 Then
        strMem(1) = "NO_CONNECTION"
    Else
        strMem(1) = "OTHER_ERROR"
    End If
    GetMembersByProperty = strMem

End Function

Procedure to test GetMembersByProperty function:

Public Sub Test()
    Dim objAddIn As COMAddIn
    Dim epm As Object
    Dim AOComAdd As Object
    Dim blnEPMInstalled As Boolean
    
    Dim strMem() As String
    Dim lngTemp As Long
    
    'Universal code to get FPMXLClient for standalone EPM or AO
    For Each objAddIn In Application.COMAddIns
        If objAddIn.progID = "FPMXLClient.Connect" Then
            Set epm = objAddIn.Object
            blnEPMInstalled = True
            Exit For
        ElseIf objAddIn.progID = "SapExcelAddIn" Then
            Set AOComAdd = objAddIn.Object
            Set epm = AOComAdd.GetPlugin("com.sap.epm.FPMXLClient")
            blnEPMInstalled = True
            Exit For
        End If
    Next objAddIn
    
    If Not blnEPMInstalled Then
        MsgBox "EPM is not installed!"
        Exit Sub
    End If
    
    strMem = GetMembersByProperty(epm.GetActiveConnection(ThisWorkbook.Worksheets("Sheet1")), _
        "SOMEDIMNAME", "SOMEPROPERTYNAME", "SOMEPROPERTYVALUE", False)
    If strMem(0) = "" Then
        Debug.Print strMem(1)
    Else
        For lngTemp = 0 To UBound(strMem)
            Debug.Print strMem(lngTemp)
        Next lngTemp
    End If
End Sub

The results of this function can be used for different checks, for DM package answer prompt generation (Simple VBA procedure to pass parameters to DM packages)  etc. You can even create your own member selector using VBA listbox as a replacement of OpenFilteredMemberSelector API.

Sample of Member Selector:

Create User Form frmSelectMembers with 3 elements:

lbxMembers – ListBox

cmbOK – CommandButton

cmbCancel – CommandButton

Add code to the frmSelectMembers code:

Option Explicit

Private blnOKPressed As Boolean

Private Sub cmbCancel_Click()
    Unload Me
End Sub

Private Sub cmbOK_Click()
    Dim lngTemp As Long
    Dim lngTemp1 As Long
    
    blnOKPressed = True
    'Read selected items
    For lngTemp = 0 To Me.lbxMembers.ListCount - 1
        If Me.lbxMembers.Selected(lngTemp) Then
            strMembs(lngTemp1) = Me.lbxMembers.List(lngTemp)
            lngTemp1 = lngTemp1 + 1
        End If
    Next lngTemp
    If lngTemp1 = 0 Then
        ReDim strMembs(0 To 0)
        strMembs(0) = ""
    Else
        ReDim Preserve strMembs(0 To lngTemp1 - 1)
    End If
    
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    Dim lngTemp As Long
    
    Me.Caption = "Select Members for " & strDimName & " Dimension"
    With Me.lbxMembers
        .ColumnCount = 1
        .ColumnWidths = "100"
        .Font.Size = 10
        .MultiSelect = fmMultiSelectMulti
        For lngTemp = 0 To UBound(strMembs)
            .AddItem
            .List(lngTemp, 0) = strMembs(lngTemp)
        Next lngTemp
    End With
End Sub

Private Sub UserForm_Terminate()
    If Not blnOKPressed Then
        ReDim strMembs(0 To 0)
        strMembs(0) = ""
    End If
End Sub

Add the code to some module to launch Member Selector function SelectMembersFilt:

Option Explicit

'Globals to pass data to and from form
Public strMembs() As String
Public strDimName As String

Public Function SelectMembersFilt(strConn As String, strDim As String, strProperty As String, _
    strPropValue As String) As String()
    
    Dim lngTemp As Long
    
    'Set global variables: strDimName and strMembs
    strDimName = strDim
    strMembs = GetMembersByProperty(strConn, strDimName, strProperty, strPropValue, False)
    
    'Load form if member list is not empty
    If strMembs(0) = "" Then
        Debug.Print strMembs(1)
    Else
        frmSelectMembers.Show vbModal
    End If
    
    SelectMembersFilt = strMembs

End Function

Public Sub SelectMembersTest()
    Dim objAddIn As COMAddIn
    Dim epm As Object
    Dim AOComAdd As Object
    Dim blnEPMInstalled As Boolean
    
    Dim strMem() As String
    Dim lngTemp As Long
    
    'Universal code to get FPMXLClient for standalone EPM or AO
    For Each objAddIn In Application.COMAddIns
        If objAddIn.progID = "FPMXLClient.Connect" Then
            Set epm = objAddIn.Object
            blnEPMInstalled = True
            Exit For
        ElseIf objAddIn.progID = "SapExcelAddIn" Then
            Set AOComAdd = objAddIn.Object
            Set epm = AOComAdd.GetPlugin("com.sap.epm.FPMXLClient")
            blnEPMInstalled = True
            Exit For
        End If
    Next objAddIn
    
    If Not blnEPMInstalled Then
        MsgBox "EPM is not installed!"
        Exit Sub
    End If
    
    strMem = SelectMembersFilt(epm.GetActiveConnection(ThisWorkbook.Worksheets("Sheet1")), _
    "SOMEDIMNAME", "SOMEPROPERTYNAME", "SOMEPROPERTYVALUE")
    
    'List selected members
    If strMem(0) = "" Then
        Debug.Print "Nothing Selected"
    Else
        For lngTemp = 0 To UBound(strMem)
            Debug.Print strMem(lngTemp)
        Next lngTemp
    End If
    
End Sub

If you run SelectMembersTest you will have something like:

Result in the Immediate window will be:

PC_PL00-00011
PC_PL01-00000
PC_PL01-00001

The standard API function OpenFilteredMemberSelector can be used with the code:

Public Sub SelectMembers()

    Dim objAddIn As COMAddIn
    Dim epm As Object
    Dim AOComAdd As Object
    Dim blnEPMInstalled As Boolean

    Dim strMembers As String
    Dim strMem() As String
    Dim lngTemp As Long
    Dim lngTemp1 As Long

    'Universal code to get FPMXLClient for standalone EPM or AO
    For Each objAddIn In Application.COMAddIns
        If objAddIn.progID = "FPMXLClient.Connect" Then
            Set epm = objAddIn.Object
            blnEPMInstalled = True
            Exit For
        ElseIf objAddIn.progID = "SapExcelAddIn" Then
            Set AOComAdd = objAddIn.Object
            Set epm = AOComAdd.GetPlugin("com.sap.epm.FPMXLClient")
            blnEPMInstalled = True
            Exit For
        End If
    Next objAddIn
    
    If Not blnEPMInstalled Then
        MsgBox "EPM is not installed!"
        Exit Sub
    End If

    strMembers = epm.OpenFilteredMemberSelector( _
        epm.GetActiveConnection(ThisWorkbook.Worksheets("Sheet1")), _
        "SOMEDIMNAME", "", "SOMEPROPERTYNAME=SOMEPROPERTYVALUE", True)
    If strMembers <> "" Then
        strMembers = Left(strMembers, Len(strMembers) - 1)
        strMem = Split(strMembers, ";")
        For lngTemp = 0 To UBound(strMem)
            lngTemp1 = InStrRev(strMem(lngTemp), "[")
            strMem(lngTemp) = Mid(strMem(lngTemp), lngTemp1 + 1, _
                Len(strMem(lngTemp)) - lngTemp1 - 1)
            Debug.Print strMem(lngTemp)
        Next lngTemp
    Else
        Debug.Print "Nothing selected"
    End If

End Sub

With the form presented to user:

Extra button has to be clicked to perform selection.

GetMembersByProperty can be slow for dimensions with a huge member list (all members of dimension are read inside this code).

Vadim

P.S. epm.GetPropertyValue function was replaced by Application.Run(“EPMMemberProperty”… to improve performance based on Evgeniy Samardak comment!


References:

BPC NW 10: VBA to get dimension members list and properties

Assigned Tags

      12 Comments
      You must be Logged on to comment or reply to a post.
      Author's profile photo Steven Rider
      Steven Rider

      Thanks Vadim. As usual, your post is creative and informative. There's a lot of ways this could be modified to meet very specific customer requirements. Keep up the great work.

      Author's profile photo Vadim Kalinin
      Vadim Kalinin
      Blog Post Author

      Code updated to support PARENTx and performance improvements...

       

      Author's profile photo Evgeniy Samardak
      Evgeniy Samardak

      On a large amount of data, this function is slow:

      epm.GetPropertyValue(strConn, CStr(varMemFull), strProperty).

      It will work more quickly

      Application.Run("EPMMemberProperty", strModelName, strDimentionName, strPropertyName).

      'strModelName="Planning" 'strDimentionName="ENTITY" 'strPropertyName="OWNER"

      There is a variant of extracting all values ​​of the dimention property

      strAllmember = Application.Run("EPMDimensionPropertyValues", strModelName,strDimentionName, strPropertyName, "", "")

      strAllmemberArr=Split(strAllmember ";")

      There is a restriction on the second option: strAllmember <= 32 767 symbol.

       

      Author's profile photo Vadim Kalinin
      Vadim Kalinin
      Blog Post Author

      Interesting! Looks like your method will use internal EPM cache. I will test it when I will be back at home.

       

      Author's profile photo Steven Rider
      Steven Rider

      Vadim Kalinin  I actually think the savings for an approach that leverages the EPM cache might be pretty significant. I just posted my findings on LinkedIN as I experienced a 20x improvement in speed by using EVALUATE instead of the BPC API calls (I would have posted this on the SAP blog but it's been pending review for too long). I gave you a shout out since some of my discoveries were in relation to some of your previous work.

      Author's profile photo Vadim Kalinin
      Vadim Kalinin
      Blog Post Author

      Interesting finding, but don't you think it depends on connection speed between your desktop and BPC server? I will test myself with evaluate instead of Application.Run

      Author's profile photo Vadim Kalinin
      Vadim Kalinin
      Blog Post Author

      Results of my tests:

      Option Explicit
      
      Dim epm As New FPMXLClient.EPMAddInAutomation
      
      Public Sub GetProp()
          Dim strConn As String
          Dim strDim As String
          Dim strProperty As String
          Dim strMem() As String
          Dim strProp() As String
          Dim dctMembers As New Scripting.Dictionary
          Dim strMemID As String
          Dim lngTemp As Long
          Dim lngTemp1 As Long
          Dim varMemFull As Variant
          Dim sngStart As Single
          
          strConn = "PLANNING - XXXXXXX"
          strDim = "COORDER"
          strProperty = "BW_COORDER"
          
          'Get full list of dimension members with duplicates due to possible multiple hierarchies
          strMem = epm.GetHierarchyMembers(strConn, "", strDim)
          For lngTemp = 0 To UBound(strMem)
              lngTemp1 = InStrRev(strMem(lngTemp), "[")
              strMemID = Mid(strMem(lngTemp), lngTemp1 + 1, Len(strMem(lngTemp)) - lngTemp1 - 1)
              'Add only unique member ID's
              If Not dctMembers.Exists(strMemID) Then
                  dctMembers.Add strMemID, strMem(lngTemp)
              End If
          Next lngTemp
          
          ReDim strProp(0 To dctMembers.Count - 1)
          
          'Loop dictionary with unique member list and read Property value 7493 members
          lngTemp = 0
          sngStart = Timer
          For Each varMemFull In dctMembers.Items
              'strProp(lngTemp) = epm.GetPropertyValue(strConn, CStr(varMemFull), strProperty)
              'strProp(lngTemp) = Application.Run("EPMMemberProperty", strConn, CStr(varMemFull), strProperty)
              strProp(lngTemp) = Evaluate("=EPMMEmberProperty(""" & strConn & """,""" & CStr(varMemFull) & """,""" & strProperty & """)")
              lngTemp = lngTemp + 1
          Next varMemFull
          Debug.Print CStr(Timer - sngStart)
      
      End Sub

      Code with Application.Run is the fastest! API call is the slowest, but not 20x times slower 🙂

      Author's profile photo Steven Rider
      Steven Rider

      You're right that it probably depends on the server, and the cached settings. I actually went to a prod environment and tried everything I could to optimize system speed  (given that it's Christmas Eve and few people are working, this is a great time to do this test!)

      I even included code that looped the checks 15 times (expanding the size of my number of calculations to almost 24 thousand on some dimensions). My results were no longer 20x, but still pretty favorable, savings of about 75% which isn't too far from your 50% displayed.

      Heres some updated test code I used that includes some pretty flexibility.

      Regardless, it's clear the API's even in the worst settings, seem to perform twice as slow or worse than other methods.

      Thanks for feedback. I'll update my post on LinkedIn.

      Here's my results in an optimal prod environment

      Author's profile photo Vadim Kalinin
      Vadim Kalinin
      Blog Post Author

      By the way, have you tested my code to get BAS members under some parent?

      Author's profile photo Steven Rider
      Steven Rider

      Hi Vadim Kalinin. Which code of yours did you want to test? Sorry, I don't stay to up-to-date with these boards.

      Author's profile photo Vadim Kalinin
      Vadim Kalinin
      Blog Post Author

      I am talking about the code in my second reply on LinkedIn - code to get base members under some parent.

      Author's profile photo Vadim Kalinin
      Vadim Kalinin
      Blog Post Author

      Just performed some tests on the dimension with 6326 members (not a huge number).

      Code:

      Option Explicit
      Dim epm As New FPMXLClient.EPMAddInAutomation
      
      Public Sub GetProp()
          Dim strConn As String
          Dim strDim As String
          Dim strProperty As String
          Dim strMem() As String
          Dim strProp() As String
          Dim dctMembers As New Scripting.Dictionary
          Dim strMemID As String
          Dim lngTemp As Long
          Dim lngTemp1 As Long
          Dim varMemFull As Variant
          Dim sngStart As Single
          
          strConn = "PLANNING - XXXXXXX"
          strDim = "COORDER"
          strProperty = "BW_COORDER"
          
          'Get full list of dimension members with duplicates due to possible multiple hierarchies
          strMem = epm.GetHierarchyMembers(strConn, "", strDim)
          For lngTemp = 0 To UBound(strMem)
              lngTemp1 = InStrRev(strMem(lngTemp), "[")
              strMemID = Mid(strMem(lngTemp), lngTemp1 + 1, Len(strMem(lngTemp)) - lngTemp1 - 1)
              'Add only unique member ID's
              If Not dctMembers.Exists(strMemID) Then
                  dctMembers.Add strMemID, strMem(lngTemp)
              End If
          Next lngTemp
          
          ReDim strProp(0 To dctMembers.Count - 1)
          
          'Loop dictionary with unique member list and read Property value
          lngTemp = 0
          sngStart = Timer
          For Each varMemFull In dctMembers.Items
              strProp(lngTemp) = epm.GetPropertyValue(strConn, CStr(varMemFull), strProperty)
              'strProp(lngTemp) = Application.Run("EPMMemberProperty", strConn, CStr(varMemFull), strProperty)
              lngTemp = lngTemp + 1
          Next varMemFull
          Debug.Print CStr(Timer - sngStart)
      
      End Sub

      Results:

      With epm.GetPropertyValue: 1.14 sec

      With Application.Run(“EPMMemberProperty”: 0.92 sec

      Not a big difference: 15%

      May be you can provide test results for really huge dimensions!