Technical Articles
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:
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.
Code updated to support PARENTx and performance improvements...
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.
Interesting! Looks like your method will use internal EPM cache. I will test it when I will be back at home.
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.
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
Results of my tests:
Code with Application.Run is the fastest! API call is the slowest, but not 20x times slower 🙂
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
By the way, have you tested my code to get BAS members under some parent?
Hi Vadim Kalinin. Which code of yours did you want to test? Sorry, I don't stay to up-to-date with these boards.
I am talking about the code in my second reply on LinkedIn - code to get base members under some parent.
Just performed some tests on the dimension with 6326 members (not a huge number).
Code:
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!