Skip to Content

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

To report this post you need to login first.

1 Comment

You must be Logged on to comment or reply to a post.

  1. 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.

    (0) 

Leave a Reply