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

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. Parameters and references are described in the code:

Option Explicit 'References to FPMXLClient and Microsoft Scripting Runtime required Dim epm As New FPMXLClient.EPMAddInAutomation 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 On Error GoTo Err Dim strDims() As String Dim strProps() As String Dim blnExistFlag As Boolean Dim strMem() As String Dim strMemID As String Dim dctMembers As New Scripting.Dictionary Dim varMem As Variant Dim varMemFull As Variant Dim lngTemp As Long Dim lngTemp1 As Long '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 'Function do not support Properties like PARENTHx If strProperty Like "PARENTH*" Then ReDim strMem(0 To 1) strMem(0) = "" strMem(1) = "NOT_PARENTH" 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 '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 'Loop dictionary with unique member list and read Property value lngTemp = 0 If blnFullMember Then For Each varMemFull In dctMembers.Items 'Check member proprty value If epm.GetPropertyValue(strConn, CStr(varMemFull), strProperty) = strPropValue Then strMem(lngTemp) = CStr(varMemFull) lngTemp = lngTemp + 1 End If Next varMemFull Else For Each varMem In dctMembers.Keys varMemFull = dctMembers.Item(varMem) 'Check member proprty value If epm.GetPropertyValue(strConn, CStr(varMemFull), strProperty) = strPropValue Then strMem(lngTemp) = CStr(varMem) lngTemp = lngTemp + 1 End If Next varMem End If 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 strMem() As String Dim lngTemp As Long 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 strMem() As String Dim lngTemp As Long 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 strMembers As String Dim strMem() As String Dim lngTemp As Long Dim lngTemp1 As Long 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