Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 'suggested from: https://www.linkedin.com/feed/update/urn:li:linkedInArticle:6481765814872739840/
- 'Ensure that FPMLCLient is enabled in references as well as Microsoft Scripting Runtime (to work with dictionary object)
- Const PropertyTocheck As String = "CALC"
- Const DimsToExclude As String = "_MEASURES_CATEGORY_SCENARIO_VERSION_RPTCURRENCY_CURRENCY_FLOW_AUDITTRAIL_DATASRC"
- Const dimExtender As Long = 20 'use this number to increase your dimensions by a factor
- Enum CalcMethods
- eCalc_Evaluate = 1
- eCalc_API = 2
- eCalc_RunTime = 3
- End Enum
- Option Explicit
- Sub LoopALLDimensions()
- 'Run this macro!
- Dim epm As FPMXLClient.EPMAddInAutomation: Set epm = New FPMXLClient.EPMAddInAutomation
- Dim AllMyDims() As String: AllMyDims = epm.GetDimensionList(epm.GetActiveConnection(ActiveSheet))
- Dim Dim_X As Long, m As CalcMethods
- For Dim_X = 0 To UBound(AllMyDims)
- If InStr(1, DimsToExclude, AllMyDims(Dim_X), vbTextCompare) = 0 Then
- Debug.Print AllMyDims(Dim_X)
- For m = eCalc_Evaluate To eCalc_RunTime
- Call GetProp(AllMyDims(Dim_X), m, PropertyTocheck)
- Next m
- End If
- Next Dim_X
- MsgBox "Task Completed"
- End Sub
- Private Sub GetProp(strDim As String, methodToCalc As Long, strProperty As String)
- Dim epm As FPMXLClient.EPMAddInAutomation: Set epm = New FPMXLClient.EPMAddInAutomation
- Dim strConn As String: strConn = epm.GetActiveConnection(ActiveSheet)
- Dim strMem() As String
- Dim strProp() As String
- Dim dctMembers As Scripting.Dictionary: Set dctMembers = New Scripting.Dictionary
- Dim strMemID As String
- Dim lngTemp As Long
- Dim lngTemp1 As Long
- Dim varMemFull As Variant
- Dim sngStart As Single 'PG: what if you run this at midnight!?!? :)
- '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 strProperty Property value for XXX members
- Dim calcTEXT As String
- Dim extendEvents As Long
- sngStart = Timer
- For extendEvents = 1 To dimExtender
- lngTemp = 0
- Select Case methodToCalc
- Case eCalc_API
- calcTEXT = "API"
- For Each varMemFull In dctMembers.Items
- strProp(lngTemp) = epm.GetPropertyValue(strConn, CStr(varMemFull), strProperty)
- lngTemp = lngTemp + 1 'PG I think you forgot this
- Next varMemFull
- Case eCalc_Evaluate
- calcTEXT = "Evaluate"
- For Each varMemFull In dctMembers.Items
- strProp(lngTemp) = Evaluate("=EPMMEmberProperty(""" & strConn & """,""" & CStr(varMemFull) & """,""" & strProperty & """)")
- lngTemp = lngTemp + 1
- Next varMemFull
- Case eCalc_RunTime
- calcTEXT = "RunTime"
- For Each varMemFull In dctMembers.Items
- strProp(lngTemp) = Application.Run("EPMMemberProperty", strConn, CStr(varMemFull), strProperty)
- lngTemp = lngTemp + 1
- Next varMemFull
- End Select
- Next extendEvents
- Debug.Print CStr(Round(Timer - sngStart, 3)) & " using " & calcTEXT & " with " & lngTemp * dimExtender & " property calculations in Dimension:" & _
- strDim & "." & strProperty
- End Sub
Add Comment
Please, Sign In to add comment