Hi Guys,
We've had some of our more advanced users ask if there's any way to automatically align the time series assumptions of multiple modular workbooks that are not located in a linked workbook project, and thereby prevent the need to manually open each workbook and enter the time series assumptions.
The most common example of this scenario is when users are working with multiple related modular workbooks, but have chosen not to include them in the same project for practical reasons, such as ease of independent distribution and use.
Hence, we've created an example of some VBA code which leverages the Modano API to open all modular workbooks in a folder and align their time series assumptions (and sheets) with those entered into a single workbook. To experience this take the following steps:
- Download the attached modular workbooks into the same directory;
- Open TimeSeriesWorkbook1.xlsb;
- Go to the time series assumptions in this workbook;
- Change the time series assumptions as required (e.g. change the number of time series periods); then
- Click the Align All Workbooks button to align the time series assumptions (and sheets) in all other workbooks in the folder.
The code requires all workbooks in the folder to have identical time series assumptions, so if you have other workbooks put them in a sub-folder, etc.
The VBA code to run this is located in a module named mAlignTimeSeries, which calls code from the Modano API, which has been imported into this workbook. You can download the Modano API using this link and import all the classes within it by clicking the Import button within it.
Source Code
For those with VBA skills I've provided the entire alignment code within the mAlignTimeSeries module so you can check it out below.
We've used this code/procedure in many client models and it works extremely well, saving minutes each time it is used. So feel free to implement as required.
M.
Option Explicit
Sub AlignRelatedWorkbookTimeSeriesAssumptions()
'Aligns the time series assumptions (and sheets) of all workbooks in the same folder as this workbook.
'Private declarations:
Dim fContinue As Boolean
Dim objFileSystemObject As Object
Dim objFolder As Object
Dim objFile As Object
Dim strFilePath As String
Dim strFileName As String
Dim rgobjFileNames As New Collection
Dim nUpdatedWorkbooksCount As Integer
Dim modappConnection As New ModanoApplication
'Checks for valid connection:
fContinue = modappConnection.ValidConnection(Nothing, False)
'Asks user:
If fContinue Then
fContinue = (MsgBox("Would you like to align the time series assumptions of all the " & _
"workbooks in the same folder as the current workbook?" & vbNewLine & vbNewLine & _
"IMPORTANT NOTE: You should save a backup of the entire folder containing the current " & _
"workbook and its related workbooks before aligning time series assumptions.", vbQuestion + vbOKCancel, _
"Update Time Series Assumptions") = vbOK)
End If
'Updates all files in the parent directory other than this workbook:
If fContinue Then
Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFileSystemObject.GetFolder(ThisWorkbook.Path)
For Each objFile In objFolder.Files
strFilePath = objFile.Path
strFileName = objFile.Name
If ((InStr(strFileName, "~") = 0) And (strFileName <> ThisWorkbook.Name)) Then
Application.StatusBar = "Updating time series of related workbook '" & strFileName & "'..."
If ProjectTimeSeriesUpdated(modappConnection, strFilePath, strFileName) Then
nUpdatedWorkbooksCount = nUpdatedWorkbooksCount + 1
Else
fContinue = False
Call MsgBox("The time series assumptions within the workbook '" & strFilePath & _
"' could not be updated.", vbExclamation, "Update Time Series Assumptions")
Exit For
End If
End If
Next objFile
Application.StatusBar = False
End If
'Activates this workbook again:
ThisWorkbook.Activate
'Informs of success:
If fContinue Then
Select Case nUpdatedWorkbooksCount
Case 0
Call MsgBox("No other workbooks were updated updated.", vbInformation, "Update Time Series Assumptions")
Case 1
Call MsgBox("The time series assumptions of 1 workbook were aligned with this workbook.", vbInformation, "Update Time Series Assumptions")
Case Else
Call MsgBox("The time series assumptions of " & nUpdatedWorkbooksCount & " workbooks were aligned with this workbook.", vbInformation, "Update Time Series Assumptions")
End Select
End If
End Sub
Private Function ProjectTimeSeriesUpdated(ByVal modappConnection As ModanoApplication, _
ByVal strProjectPath As String, _
ByVal strWorkbookName As String) As Boolean
'Returns true if the time series is updated in the designated project:
'NOTE: The project is assumed to have the same time series module as this project.
'Private declarations:
Dim fUpdated As Boolean
Dim fContinue As Boolean
Dim strErrorMessage As String
Dim xlwsSourceTsAssAssRows As Excel.Range
Dim xlwsDestinationTsAssAssRows As Excel.Range
Dim projActive As Project
Dim remresxlsettingsApplied As RemoveRestoreExcelSettings
Dim nTsAssRowsCount As Long
Dim nTsAssRowNumber As Long
Dim xlrngRowSource As Excel.Range
Dim xlrngRowDestination As Excel.Range
Dim rgxlrngRowCellBlocks As Variant
Dim nIndex As Long
Dim xlrngSource As Excel.Range
Dim xlrngDestination As Excel.Range
Dim xlwbUpdate As Excel.Workbook
Dim fWorkbookOpened As Boolean
Dim fAssumptionsAligned As Boolean
'Assumes OK to start:
fContinue = True
'Gets the time series assumptions sheet in this workbook:
If fContinue Then
Set xlwsSourceTsAssAssRows = GetWorkbookTimeSeriesAssumptionsRows(modappConnection, Application.ThisWorkbook)
If (xlwsSourceTsAssAssRows Is Nothing) Then
fContinue = False
strErrorMessage = "The time series assumptions in the workbook '" & strProjectPath & "' could not be updated " & _
"because the time series assumptions could not be located within this workbook."
End If
End If
'Opens if necessary:
If fContinue Then
On Error Resume Next
Set xlwbUpdate = Application.Workbooks(strWorkbookName)
On Error GoTo 0
If (xlwbUpdate Is Nothing) Then
Set xlwbUpdate = Application.Workbooks.Open(strProjectPath)
If (xlwbUpdate Is Nothing) Then
fContinue = False
strErrorMessage = "The time series assumptions in the workbook '" & strProjectPath & "' could not be updated " & _
"because this workbook could not be opened." & vbNewLine & vbNewLine & _
"Open this workbook manually to align time series assumptions."
Else
fWorkbookOpened = True
End If
ElseIf (UCase(xlwbUpdate.FullName) <> UCase(strProjectPath)) Then
fContinue = False
strErrorMessage = "The time series assumptions in the workbook '" & strProjectPath & "' could not be updated " & _
"because a workbook named '" & strWorkbookName & "' is already open." & vbNewLine & vbNewLine & _
"Close this workbook before reattempting to align time series assumptions."
Else
xlwbUpdate.Activate
End If
End If
'Gets the project:
If fContinue Then
Set projActive = modappConnection.GetActiveProject
If (projActive Is Nothing) Then
fContinue = False
strErrorMessage = "The time series assumptions in the workbook '" & strProjectPath & "' could not be updated " & _
"because the Modano Excel add-in could not locate its project." & vbNewLine & vbNewLine & _
"Please contact Modano if this problem persists."
End If
End If
'Gets the modular workbook time series assumptions rows:
If fContinue Then
Set xlwsDestinationTsAssAssRows = GetWorkbookTimeSeriesAssumptionsRows(modappConnection, xlwbUpdate)
If (xlwsDestinationTsAssAssRows Is Nothing) Then
fContinue = False
strErrorMessage = "The time series assumptions in the workbook '" & strProjectPath & "' could not be updated " & _
"because the time series assumptions could not be located within this workbook."
ElseIf (xlwsDestinationTsAssAssRows.Address <> xlwsSourceTsAssAssRows.Address) Then
fContinue = False
strErrorMessage = "The time series assumptions in the workbook '" & strProjectPath & "' could not be updated " & _
"because they are not identical to the time series assumptions in this workbook."
End If
End If
'Temporarily removes Excel settings:
If fContinue Then Set remresxlsettingsApplied = New RemoveRestoreExcelSettings
'Aligns the time series assumptions:
If fContinue Then
'Allows for errors:
On Error Resume Next
'Aligns:
nTsAssRowsCount = xlwsDestinationTsAssAssRows.Rows.Count
For nTsAssRowNumber = 1 To nTsAssRowsCount
Set xlrngRowDestination = xlwsDestinationTsAssAssRows.Rows(nTsAssRowNumber)
rgxlrngRowCellBlocks = modappConnection.GetRowCellBlockRanges(xlrngRowDestination)
If IsArray(rgxlrngRowCellBlocks) Then
Set xlrngRowSource = xlwsSourceTsAssAssRows.Rows(nTsAssRowNumber)
For nIndex = LBound(rgxlrngRowCellBlocks) To UBound(rgxlrngRowCellBlocks)
Set xlrngDestination = rgxlrngRowCellBlocks(nIndex)
Set xlrngDestination = xlrngDestination.Cells(1, 1)
Set xlrngSource = xlrngRowSource.Cells(1, xlrngDestination.Column)
If ((Not xlrngSource.Locked) And (Not xlrngSource.HasFormula)) Then
If ((Not xlrngDestination.Locked) And (Not xlrngDestination.HasFormula)) Then
If ((xlrngSource.Style.Name = xlrngDestination.Style.Name) And _
(xlrngSource.NumberFormat = xlrngDestination.NumberFormat)) Then
Application.EnableEvents = False
xlrngDestination.Value = xlrngSource.Value
fAssumptionsAligned = True
End If
End If
End If
Next nIndex
End If
Next nTsAssRowNumber
'Removes error handling:
On Error GoTo 0
End If
'Restores settings:
If (Not remresxlsettingsApplied Is Nothing) Then Call remresxlsettingsApplied.RestoreSettings
'Checks for something updated:
If fContinue Then
If (Not fAssumptionsAligned) Then
fContinue = False
strErrorMessage = "The time series assumptions in the workbook '" & strProjectPath & "' could not be updated " & _
"because its time series assumptions were not consistent with those in this workbook." & vbNewLine & vbNewLine & _
"Please contact Modano if this problem persists."
End If
End If
'Updates the time series period titles:
If fContinue Then
fUpdated = projActive.TimeSeriesPeriodTitlesUpdated(True)
If (Not fUpdated) Then
fContinue = False
strErrorMessage = "The time series assumptions in the workbook '" & strProjectPath & "' could not be updated " & _
"by the Modano Excel add-in." & vbNewLine & vbNewLine & _
"Upgrade your Modano Excel add-in to the latest version and contact Modano if this problem persists."
End If
End If
'If the workbook was opened, saves and closes it:
On Error GoTo 0
If fContinue Then
If fWorkbookOpened Then
If (Not projActive.Save("")) Then
fContinue = False
fUpdated = False
strErrorMessage = "The workbook '" & strProjectPath & "' could not be saved " & _
"by the Modano Excel add-in." & vbNewLine & vbNewLine & _
"Upgrade your Modano Excel add-in to the latest version and contact Modano if this problem persists."
Else
Call projActive.CloseProject
End If
End If
End If
'Warns if error:
If (Not fContinue) Then
If (Len(strErrorMessage) > 0) Then
Call MsgBox(strErrorMessage, vbExclamation, "Update Time Series Assumptions")
End If
End If
'Returns:
ProjectTimeSeriesUpdated = fUpdated
End Function
Private Function GetWorkbookTimeSeriesAssumptionsRows(modappConnection As ModanoApplication, _
xlwbModularWorkbook As Excel.Workbook) As Excel.Range
'Returns the time series assumptions Excel rows range within the specified modular workbook:
Dim xlrngTsAssRows As Excel.Range
Dim mwbThisWorkbook As ModulesWorkbook
Dim modTimeSeries As ModanoModule
Dim modcompTsAss As ModuleComponent
If (Not modappConnection Is Nothing) Then
If (Not xlwbModularWorkbook Is Nothing) Then
Set mwbThisWorkbook = modappConnection.GetWorkbookModulesWorkbook(xlwbModularWorkbook)
If (Not mwbThisWorkbook Is Nothing) Then
Set modTimeSeries = mwbThisWorkbook.Modules.GetTimeSeriesModule
If (Not modTimeSeries Is Nothing) Then
Set modcompTsAss = modTimeSeries.ModuleComponents.FirstAssumptionsModuleComponent
If (Not modcompTsAss Is Nothing) Then
Set xlrngTsAssRows = modcompTsAss.ExcelRowsRange
End If
End If
End If
End If
End If
Set GetWorkbookTimeSeriesAssumptionsRows = xlrngTsAssRows
End Function
Awesome! Super helpful, thanks Mike!
Jun