8
\$\begingroup\$

This: enter image description here

Is a data table we get from our financial platform with lots of useful information. For reference, "--" is also the string they use to denote empty values.

This: enter image description here

Is a spreadsheet I built (and had reviewed here) to track our customers' regular income requirements.

The code produces reports to show:

  • Whether clients with upcoming income have sufficient cash available in their accounts

  • Which accounts have a large % uninvested (above a minimum threshold value)

  • Which accounts are not attached to an investment model

  • A table of account notes appended to each of the above

Overview of the code:

Step 1: Get raw data into arrays
Step 2: Clean said data
Step 3: Produce Reports
Step 4: Print Reports to sheets and Format Presentation

N.B. The worksheet variables are codenames
N.B. There are a number of what I'll call "standard Functions" that appear in the code. You may safely assume that they do what they say they do.

As always, open to any and all feedback, at any level of abstraction. That said, I'm especially interested in the larger project-structure and general maintainability.

Module B1_Public_Variables

Option Explicit
Public Const WB_INCOME_LIST_FILEPATH As String = "S:\Lumin Admin Docs\Ascentric Cash Management\"
Public Const WB_INCOME_LIST_FILENAME As String = "Ascentric Client Income List.xlsm"
Public Const ASCENTRIC_TOP_LEFT_CELL_STRING As String = "Adviser" '/ At present, on row 3
Public Const NOTES_TOP_LEFT_CELL_STRING As String = "Adviser"
'/ Headers for this workbook
Public Const ADVISER_NAME_HEADER As String = "Adviser"
Public Const CLIENT_NAME_HEADER As String = "Client Name"
Public Const ASCENTRIC_NUMBER_HEADER As String = "Client Ref"
Public Const PRODUCT_CODE_HEADER As String = "Product"
Public Const WRAPPER_VALUE_HEADER As String = "Wrapper Value (WV)"
Public Const INVESTMENT_MODEL_HEADER As String = "Model Name"
Public Const DEPOSIT_ACCOUNT_HEADER As String = "Deposit Cash"
Public Const RESERVE_ACCOUNT_HEADER As String = "Reserve Cash"
Public Const INCOME_ACCOUNT_HEADER As String = "Income Account"
Public Const TRADING_ACCOUNT_HEADER As String = "Trading Account"
Public Const SIPP_INCOME_HEADER As String = "SIPP Income £"
Public Const REGULAR_INCOME_HEADER As String = "Reg Income £"
Public Const ACCOUNT_TO_TAKE_INCOME_FROM_HEADER As String = "Income Taken From"
Public Const INCOME_FREQUENCY_HEADER As String = "Income Frequency"
Public Const NEXT_INCOME_DATE_HEADER As String = "Next Send Date"
Public Const NOTES_HEADER As String = "Notes"
'/ Headers for Client Income workbook
Public WsIncClientNameHeader As String
Public WsIncIncomeAmountHeader As String
Public WsIncPaymentFrequencyHeader As String
Public WsIncPaymentDayHeader As String
Public WsIncBaseMonthHeader As String
Public WsIncAscentricWrapperHeader As String
Public WsIncAscentricAccountNumberHeader As String
Public WsIncAccountToPayFromHeader As String
Public WsIncNextIncomeDateHeader As String
'/ Income Report
Public Const SHORTFALL_HEADER As String = "Shortfall?"
Public IncomeReportColumnNumbers As Scripting.Dictionary
'/ Uninvested Cash Report
Public Const DEPOSIT_PERCENT_OF_WRAPPER_HEADER As String = "Deposit Cash % of WV"

Module C1_Main_Sub

Option Explicit
Public Sub GenerateAscentricReports()
 StoreApplicationSettings
 DisableApplicationSettings
 '/========================================================================================================================================================================================================================================================================
 '/ Description:
 '/========================================================================================================================================================================================================================================================================
 '/ Author: Zak Armstrong
 '/
 '/ Inputs:
 '/ A copy-pasted Data Table from Ascentric (provided as MS Excel export). Specifically, the company-wide "Uninvested Cash" Report.
 '/ An internal spreadsheet used to track all Ascentric clients who take regular income.
 '/ A table of account notes (This Workbook)
 '/
 '/ Outputs:
 '/ A list of all uninvested cash (by account), sorted by % of total account value.
 '/ A list of all scheduled income payments, with indications of whether sufficient cash is available to pay it. (Currently only indicated for payments due within 2 weeks)
 '/ A list of all Accounts not currently attached to an investment Model
 '/ Account Notes appended to the above
 '/
 '/ Data structure / Unique identifiers:
 '/ Ascentric account number. Usually 1 per client (2 if a personal and a joint account). All-digits, no fixed length, no leading zeroes. Typically 8 or 9 digits.
 '/ Product codes. Each account can contain multiple products E.G. Pension Account (APA), ISA, General Investment Account (GIA). sometimes more than one of each E.G. APA, APA2, APA3 etc.
 '/ Each line in each table refers to one Account number and one product code. If either is missing, data cannot be allocated.
 '/========================================================================================================================================================================================================================================================================
 '/========================================================================================================================================================================================================================================================================
 Dim wbUninvestedCash As Workbook, wbIncomeList As Workbook
 Set wbUninvestedCash = ThisWorkbook
 Set wbIncomeList = GetWorkbook(WB_INCOME_LIST_FILENAME, WB_INCOME_LIST_FILEPATH)
 ActivateAndUnmerge wsAscentricData
 Set IncomeReportColumnNumbers = InitialiseIncomeReportColumnNumbers
 '/ Ascentric Data Variables ======================================================================================
 Dim ascentricDataArray As Variant, ascentricDataRange As Range, ascentricColumnNumbers As Scripting.Dictionary
 ascentricDataArray = Array()
 Set ascentricDataRange = GetAscentricDataRange
 ascentricDataArray = ascentricDataRange
 Set ascentricColumnNumbers = GetAscentricColumnIndexes(ascentricDataArray)
 '/ Notes Data Variables ======================================================================================
 Dim notesDataArray As Variant, notesDataRange As Range
 notesDataArray = Array()
 Set notesDataRange = GetNotesDataRange
 notesDataArray = notesDataRange
 '/ Lumin Client Income Data Variables ======================================================================================
 Dim luminClientIncomeDataArray As Variant, luminClientIncomeColumnNumbers As Scripting.Dictionary
 wbIncomeList.GetDataTableHeaders clientNameHeader:=WsIncClientNameHeader _
 , incomeAmountHeader:=WsIncIncomeAmountHeader _
 , paymentFrequencyHeader:=WsIncPaymentFrequencyHeader _
 , paymentDayHeader:=WsIncPaymentDayHeader _
 , baseMonthHeader:=WsIncBaseMonthHeader _
 , ascentricWrapperHeader:=WsIncAscentricWrapperHeader _
 , ascentricAccountNumberHeader:=WsIncAscentricAccountNumberHeader _
 , accountToPayFromHeader:=WsIncAccountToPayFromHeader _
 , nextIncomeDateHeader:=WsIncNextIncomeDateHeader
 luminClientIncomeDataArray = GetClientIncomeDataArray(wbIncomeList, Year(Now))
 Set luminClientIncomeColumnNumbers = GetClientIncomeColumnIndexes(luminClientIncomeDataArray)
 CloseWorkbook wbIncomeList
 '/ Clean Up data ======================================================================================
 CleanUpAscentricData ascentricDataArray
 CleanUpNotesData notesDataArray
 CleanUpClientIncomeData luminClientIncomeDataArray, luminClientIncomeColumnNumbers
 '/ Client Income Data Variables ======================================================================================
 Dim ascentricClientIncomeDataArray As Variant, luminIncomeDataArray
 ascentricClientIncomeDataArray = GetIncomeFromDataArray(ascentricDataArray, ascentricColumnNumbers)
 luminIncomeDataArray = GetIncomeFromDataArray(luminClientIncomeDataArray, luminClientIncomeColumnNumbers, hasAdviser:=False)
 AddAccountBalancesAndAdvisersToLuminIncome ascentricDataArray, luminIncomeDataArray
 Dim removedIncomeRows As Variant
 removedIncomeRows = Array()
 removedIncomeRows = InitialiseIncomeArray()
 ascentricClientIncomeDataArray = RemoveMissingPayDates(ascentricClientIncomeDataArray, removedIncomeRows)
 luminIncomeDataArray = RemoveMissingPayDates(luminIncomeDataArray, removedIncomeRows)
 '/ Client Income Report ======================================================================================
 '/ In case of collisions between Ascentric and Client Income Workbook, Client Income Workbook takes precedence
 Dim incomeReportArray As Variant
 incomeReportArray = MergeIncomeArrays(luminIncomeDataArray, ascentricClientIncomeDataArray)
 CleanIncomeReportArray incomeReportArray
 CleanIncomeReportArray removedIncomeRows
 incomeReportArray = AddShortFallColumnToIncomeReport(incomeReportArray)
 removedIncomeRows = AddShortFallColumnToIncomeReport(removedIncomeRows)
 incomeReportArray = AppendNotes(incomeReportArray, notesDataArray)
 removedIncomeRows = AppendNotes(removedIncomeRows, notesDataArray)
 '/ "Not Attached To Model" Report ======================================================================================
 Dim noModelArray As Variant
 noModelArray = GetRowsWithMissingModel(ascentricDataArray)
 noModelArray = AppendNotes(noModelArray, notesDataArray)
 '/ Uninvested Cash Report ======================================================================================
 Dim uninvestedCashReport As Variant
 uninvestedCashReport = GetUninvestedCashReport(ascentricDataArray)
 uninvestedCashReport = AppendDepositPercentOfWrapper(uninvestedCashReport)
 uninvestedCashReport = GetAccountsAboveThresholdValue(uninvestedCashReport, 10000)
 uninvestedCashReport = AppendNotes(uninvestedCashReport, notesDataArray)
 '/ Print reports + Visual Formatting ======================================================================================
 Dim ws As Worksheet
 Dim arr As Variant
 Set ws = wsClientIncomeReport
 arr = incomeReportArray
 ws.Cells.Clear
 Print2dArrayToSheet wbUninvestedCash, ws, arr, ws.Cells(1, 1)
 FormatIncomeReportVisuals arr, ws
 Set ws = wsRemovedIncome
 arr = removedIncomeRows
 ws.Cells.Clear
 Print2dArrayToSheet wbUninvestedCash, ws, arr, ws.Cells(1, 1)
 FormatIncomeReportVisuals arr, ws
 Set ws = wsNoModelAttachedreport
 arr = noModelArray
 ws.Cells.Clear
 Print2dArrayToSheet wbUninvestedCash, ws, arr, ws.Cells(1, 1)
 FormatNoModelReportVisuals arr, ws
 Set ws = wsUninvestedCashReport
 arr = uninvestedCashReport
 ws.Cells.Clear
 Print2dArrayToSheet wbUninvestedCash, ws, arr, ws.Cells(1, 1)
 FormatUninvestedCashReportVisuals arr, ws
 RestoreApplicationSettings
End Sub

Module C2_Get_Data_Ranges

Option Explicit
Public Function GetAscentricDataRange() As Range
 Set GetAscentricDataRange = GetTableRange(wsAscentricData, ASCENTRIC_TOP_LEFT_CELL_STRING, useCurrentRegion:=False) '/ Not Current Region because un-merging may split table into multiple regions
End Function
Public Function GetNotesDataRange() As Range
 Set GetNotesDataRange = GetTableRange(wsAccountNotes, NOTES_TOP_LEFT_CELL_STRING, useCurrentRegion:=False) '/ Not Current Region because un-merging may split table into multiple regions
End Function
Public Function GetTableRange(ByRef ws As Worksheet, ByVal topLeftCellText As String, Optional ByVal useCurrentRegion As Boolean = True)
 ws.Activate
 Dim dataRange As Range
 Dim topLeftCell As Range, searchRange As Range
 Set searchRange = ws.Range(Cells(1, 1), Cells(10, 10)) '/ 10x10 is a purely arbitrary search range that should cover almost all typical spreadsheets
 Set topLeftCell = CellContainingStringInRange(searchRange, topLeftCellText)
 Dim tableFinalRow As Long, tableFinalCol As Long
 AssignRangeBoundsOfData topLeftCell, UB1:=tableFinalRow, UB2:=tableFinalCol, useCurrentRegion:=useCurrentRegion '/ Not Current Region because un-merging may split table into multiple regions
 Set dataRange = ws.Range(topLeftCell, Cells(tableFinalRow, tableFinalCol))
 Set GetTableRange = dataRange
End Function

Module C3_Get_Data_Arrays

Option Explicit
Public Function GetClientIncomeDataArray(ByRef wbIncomeList As Workbook, ByVal ixYear As Long) As Variant
 '/ Gets data array from Client Inome Workbook, **then** converts it to use same headers/format as ascentric data.
 Dim dataArray As Variant
 Dim codenameClientIncomeWs As String
 '/ I don't like the hacky nature of this, but it will run fine for the next 2 years by which time I sincerely *hope* we'll have moved to a proper database system
 With wbIncomeList
 If ixYear = 2015 Then .GetWorksheetCodenames ws2015:=codenameClientIncomeWs
 If ixYear = 2016 Then .GetWorksheetCodenames ws2016:=codenameClientIncomeWs
 If ixYear = 2017 Then .GetWorksheetCodenames ws2017:=codenameClientIncomeWs
 End With
 dataArray = wbIncomeList.GetDataArrayFromSheetByCodename(codenameClientIncomeWs)
 dataArray = ConvertLuminIncomeToAscentricIncomeFormat(dataArray)
 GetClientIncomeDataArray = dataArray
End Function

Module C4_Get_Column_Indexes

It should be noted around here that I originally thought I would store all the arrays' column indexes in dictionaries and then pass those around. By about halfway through the main sub I decided I preferred each function to dynamically determine where column headers are instead.

Option Explicit
Public Function ColumnIndexesOfStringsInArrayRow(ByRef searchStrings As Collection, ByRef dataArray As Variant, ByVal rowToSearch As Long) As Scripting.Dictionary
 Dim dict As Scripting.Dictionary
 Set dict = New Scripting.Dictionary
 Dim arrSearchRow As Variant
 arrSearchRow = RowFrom2dArray(dataArray, rowToSearch)
 Dim searchText As String, colNum As Long
 Dim ix As Long
 For ix = 1 To searchStrings.Count
 searchText = searchStrings(ix)
 colNum = IndexInArray1d(arrSearchRow, searchText)
 dict.Add searchText, colNum
 Next ix
 Set ColumnIndexesOfStringsInArrayRow = dict
End Function
Public Function GetAscentricColumnIndexes(ByRef ascentricDataArray As Variant) As Scripting.Dictionary
 Dim headers As Collection
 Set headers = GetAscentricHeaders
 Dim headerRow As Long
 headerRow = LBound(ascentricDataArray, 1)
 Dim dict As Scripting.Dictionary
 Set dict = ColumnIndexesOfStringsInArrayRow(headers, ascentricDataArray, headerRow)
 Set GetAscentricColumnIndexes = dict
End Function
Public Function GetClientIncomeColumnIndexes(ByRef clientIncomeDataArray As Variant) As Scripting.Dictionary
 Dim headers As Collection
 Set headers = GetClientIncomeHeaders
 Dim headerRow As Long
 headerRow = LBound(clientIncomeDataArray, 1)
 Dim dict As Scripting.Dictionary
 Set dict = ColumnIndexesOfStringsInArrayRow(headers, clientIncomeDataArray, headerRow)
 Set GetClientIncomeColumnIndexes = dict
End Function

Module C5_Clean_Array_Data

Option Explicit
Public Sub CleanUpAscentricData(ByRef ascentricDataArray As Variant)
 Dim valueToReplace As String, replacementValue As Variant
 ascentricDataArray = Trim2DArrayValues(ascentricDataArray)
 valueToReplace = "--"
 replacementValue = CLng("0")
 ascentricDataArray = FindAndReplace2DArrayValues(ascentricDataArray, valueToReplace, replacementValue)
 valueToReplace = "AGENERAL"
 replacementValue = "GIA"
 ascentricDataArray = FindAndReplace2DArrayValues(ascentricDataArray, valueToReplace, replacementValue)
 valueToReplace = "AGENERAL2"
 replacementValue = "GIA2"
 ascentricDataArray = FindAndReplace2DArrayValues(ascentricDataArray, valueToReplace, replacementValue)
 valueToReplace = "AGENERAL3"
 replacementValue = "GIA3"
 ascentricDataArray = FindAndReplace2DArrayValues(ascentricDataArray, valueToReplace, replacementValue)
 valueToReplace = "AGENERAL4"
 replacementValue = "GIA4"
 ascentricDataArray = FindAndReplace2DArrayValues(ascentricDataArray, valueToReplace, replacementValue)
 Dim headerRow As Variant
 headerRow = RowFrom2dArray(ascentricDataArray, 1)
 Dim payDateCol As Long
 payDateCol = IndexInArray1d(headerRow, NEXT_INCOME_DATE_HEADER)
 Dim LB1 As Long, UB1 As Long
 Dim LB2 As Long, UB2 As Long
 AssignArrayBounds ascentricDataArray, LB1, UB1, LB2, UB2
 Dim ix As Long, value As String, payDate As Date
 For ix = LB1 + 1 To UB1
 value = CStr(ascentricDataArray(ix, payDateCol))
 payDate = CDate(value)
 ascentricDataArray(ix, payDateCol) = payDate
 Next ix
End Sub
Public Sub CleanUpNotesData(ByRef notesDataArray As Variant)
 Dim valueToReplace As String, replacementValue As Variant
 notesDataArray = Trim2DArrayValues(notesDataArray)
 valueToReplace = "AGENERAL"
 replacementValue = "GIA"
 notesDataArray = FindAndReplace2DArrayValues(notesDataArray, valueToReplace, replacementValue)
 valueToReplace = "AGENERAL2"
 replacementValue = "GIA2"
 notesDataArray = FindAndReplace2DArrayValues(notesDataArray, valueToReplace, replacementValue)
 valueToReplace = "AGENERAL3"
 replacementValue = "GIA3"
 notesDataArray = FindAndReplace2DArrayValues(notesDataArray, valueToReplace, replacementValue)
 valueToReplace = "AGENERAL4"
 replacementValue = "GIA4"
 notesDataArray = FindAndReplace2DArrayValues(notesDataArray, valueToReplace, replacementValue)
End Sub
Public Sub CleanUpClientIncomeData(ByRef clientIncomeDataArray As Variant, ByRef clientIncomeColumnNumbers As Scripting.Dictionary)
 Dim ix As Long
 clientIncomeDataArray = Trim2DArrayValues(clientIncomeDataArray)
 '/ For each of the required columns (and only the required columns), remove "N/A"
 Dim LB1 As Long, UB1 As Long
 Dim LB2 As Long, UB2 As Long
 AssignArrayBounds clientIncomeDataArray, LB1, UB1, LB2, UB2
 Dim valueToReplace As String, replacementValue As String
 valueToReplace = "N/A"
 replacementValue = vbNullString
 Dim key As Variant, colNum As Long, columnArray As Variant
 For Each key In clientIncomeColumnNumbers.Keys()
 colNum = clientIncomeColumnNumbers.item(key)
 columnArray = ColumnFrom2dArray(clientIncomeDataArray, colNum)
 columnArray = FindAndReplace1DArrayValues(columnArray, valueToReplace, replacementValue)
 For ix = LB1 To UB1
 clientIncomeDataArray(ix, colNum) = columnArray(ix)
 Next ix
 Next key
 Dim headerRow As Variant
 headerRow = RowFrom2dArray(clientIncomeDataArray, 1)
 Dim payDateCol As Long
 payDateCol = IndexInArray1d(headerRow, NEXT_INCOME_DATE_HEADER)
 Dim value As String, payDate As Date
 For ix = LB1 + 1 To UB1
 value = CStr(clientIncomeDataArray(ix, payDateCol))
 payDate = CDate(value)
 clientIncomeDataArray(ix, payDateCol) = payDate
 Next ix
End Sub
Public Sub CleanIncomeReportArray(ByRef incomeReportArray As Variant)
 Dim valueToReplace As String, replacementValue As Variant
 valueToReplace = ""
 replacementValue = 0
 incomeReportArray = FindAndReplace2DArrayValues(incomeReportArray, valueToReplace, replacementValue)
End Sub

Module D1_Income_Report

Option Explicit
Public Function GetIncomeFromDataArray(ByRef dataArray As Variant, ByRef columnNumbers As Scripting.Dictionary, Optional ByVal hasAdviser As Boolean = True) As Variant
 Dim numIncomeColumns As Long
 Dim newArr As Variant
 newArr = Array()
 Dim ix As Long, iy As Long
 Dim takesIncome As Boolean
 Dim LB1 As Long, UB1 As Long
 AssignArrayBounds dataArray, LB1, UB1
 Dim regIncomeColumn As Long, sippIncomeColumn As Long
 regIncomeColumn = columnNumbers.item(REGULAR_INCOME_HEADER)
 sippIncomeColumn = columnNumbers.item(SIPP_INCOME_HEADER)
 newArr = InitialiseIncomeArray()
 numIncomeColumns = UBound(newArr, 2)
 Dim sourceColNum As Long, currentRow As Long, header As String, value As Variant
 Dim regIncomeAmount As Double, sippIncomeAmount As Double
 Dim incomeCount As Long
 Transpose2dArray newArr
 incomeCount = 0
 For ix = LB1 + 1 To UB1 '/ +1 for headers
 value = dataArray(ix, regIncomeColumn)
 If Len(value) > 0 Then regIncomeAmount = CDbl(dataArray(ix, regIncomeColumn)) Else regIncomeAmount = 0
 value = dataArray(ix, sippIncomeColumn)
 If Len(value) > 0 Then sippIncomeAmount = CDbl(dataArray(ix, sippIncomeColumn)) Else sippIncomeAmount = 0
 takesIncome = (regIncomeAmount > 0 Or sippIncomeAmount > 0)
 If takesIncome Then
 incomeCount = incomeCount + 1
 currentRow = incomeCount + 1 '/ +1 for headers
 ReDim Preserve newArr(1 To numIncomeColumns, 1 To currentRow)
 For iy = 1 To numIncomeColumns
 header = newArr(iy, 1)
 sourceColNum = columnNumbers.item(header)
 If header = ADVISER_NAME_HEADER Then
 If hasAdviser Then
 value = dataArray(ix, sourceColNum)
 newArr(iy, currentRow) = value
 End If
 Else
 value = dataArray(ix, sourceColNum)
 newArr(iy, currentRow) = value
 End If
 Next iy
 End If
 Next ix
 Transpose2dArray newArr
 GetIncomeFromDataArray = newArr
End Function
Public Sub AddAccountBalancesAndAdvisersToLuminIncome(ByRef ascentricIncomeDataArray As Variant, ByRef luminIncomeDataArray As Variant)
 '/ Ascentric
 Dim ascentricLB1 As Long, ascentricUB1 As Long
 Dim ascentricLB2 As Long, ascentricUB2 As Long
 AssignArrayBounds ascentricIncomeDataArray, ascentricLB1, ascentricUB1, ascentricLB2, ascentricUB2
 Dim ascentricHeaderRow As Variant
 ascentricHeaderRow = RowFrom2dArray(ascentricIncomeDataArray, ascentricLB1)
 Dim ascentricDepositCol As Long, ascentricReserveCol As Long
 Dim ascentricIncomeCol As Long, ascentricTradingCol As Long
 ascentricDepositCol = IndexInArray1d(ascentricHeaderRow, DEPOSIT_ACCOUNT_HEADER)
 ascentricReserveCol = IndexInArray1d(ascentricHeaderRow, RESERVE_ACCOUNT_HEADER)
 ascentricIncomeCol = IndexInArray1d(ascentricHeaderRow, INCOME_ACCOUNT_HEADER)
 ascentricTradingCol = IndexInArray1d(ascentricHeaderRow, TRADING_ACCOUNT_HEADER)
 Dim ascentricNumberCol As Long, ascentricProductCol As Long
 ascentricNumberCol = IndexInArray1d(ascentricHeaderRow, ASCENTRIC_NUMBER_HEADER)
 ascentricProductCol = IndexInArray1d(ascentricHeaderRow, PRODUCT_CODE_HEADER)
 Dim ascentricAdviserCol As Long
 ascentricAdviserCol = IndexInArray1d(ascentricHeaderRow, ADVISER_NAME_HEADER)
 '/ Lumin
 Dim luminLB1 As Long, luminUB1 As Long
 Dim luminLB2 As Long, luminUB2 As Long
 AssignArrayBounds luminIncomeDataArray, luminLB1, luminUB1, luminLB2, luminUB2
 Dim luminHeaderRow As Variant
 luminHeaderRow = RowFrom2dArray(luminIncomeDataArray, luminLB1)
 Dim luminDepositCol As Long, luminReserveCol As Long
 Dim luminIncomeCol As Long, luminTradingCol As Long
 luminDepositCol = IndexInArray1d(luminHeaderRow, DEPOSIT_ACCOUNT_HEADER)
 luminReserveCol = IndexInArray1d(luminHeaderRow, RESERVE_ACCOUNT_HEADER)
 luminIncomeCol = IndexInArray1d(luminHeaderRow, INCOME_ACCOUNT_HEADER)
 luminTradingCol = IndexInArray1d(luminHeaderRow, TRADING_ACCOUNT_HEADER)
 Dim luminNumberCol As Long, luminProductCol As Long
 luminNumberCol = IndexInArray1d(luminHeaderRow, ASCENTRIC_NUMBER_HEADER)
 luminProductCol = IndexInArray1d(luminHeaderRow, PRODUCT_CODE_HEADER)
 Dim luminAdviserCol As Long
 luminAdviserCol = IndexInArray1d(luminHeaderRow, ADVISER_NAME_HEADER)
 Dim ix As Long
 Dim i As Long
 Dim accountNum As String, product As String
 Dim luminUnid As String, ascentricUnid As String
 For ix = luminLB1 + 1 To luminUB1
 accountNum = luminIncomeDataArray(ix, luminNumberCol)
 product = luminIncomeDataArray(ix, luminProductCol)
 luminUnid = accountNum & ";" & product
 For i = ascentricLB1 To ascentricUB1
 accountNum = ascentricIncomeDataArray(i, ascentricNumberCol)
 product = ascentricIncomeDataArray(i, ascentricProductCol)
 ascentricUnid = accountNum & ";" & product
 If luminUnid = ascentricUnid Then
 luminIncomeDataArray(ix, luminDepositCol) = ascentricIncomeDataArray(i, ascentricDepositCol)
 luminIncomeDataArray(ix, luminReserveCol) = ascentricIncomeDataArray(i, ascentricReserveCol)
 luminIncomeDataArray(ix, luminTradingCol) = ascentricIncomeDataArray(i, ascentricTradingCol)
 luminIncomeDataArray(ix, luminIncomeCol) = ascentricIncomeDataArray(i, ascentricIncomeCol)
 luminIncomeDataArray(ix, luminAdviserCol) = ascentricIncomeDataArray(i, ascentricAdviserCol)
 End If
 Next i
 Next ix
End Sub
Public Function RemoveMissingPayDates(ByRef dataArray As Variant, ByRef removedIncomeRows As Variant) As Variant
 Dim ix As Long, iy As Long
 Dim sourceLB1 As Long, sourceUB1 As Long
 Dim sourceLB2 As Long, sourceUB2 As Long
 AssignArrayBounds dataArray, sourceLB1, sourceUB1, sourceLB2, sourceUB2
 Dim headerRow As Variant
 headerRow = RowFrom2dArray(dataArray, 1)
 Dim payDateCol As Long
 payDateCol = IndexInArray1d(headerRow, NEXT_INCOME_DATE_HEADER)
 Dim filteredArray As Variant
 filteredArray = Array()
 ReDim filteredArray(1 To 1, sourceLB2 To sourceUB2)
 For iy = sourceLB2 To sourceUB2
 filteredArray(1, iy) = headerRow(iy)
 Next iy
 Dim dateIsMissing As Boolean, payDate As Date
 Dim filteredRow As Long, removedRow As Long
 removedRow = UBound(removedIncomeRows, 1)
 filteredRow = 1
 Transpose2dArray filteredArray
 Transpose2dArray removedIncomeRows
 For ix = sourceLB1 + 1 To sourceUB1
 payDate = dataArray(ix, payDateCol)
 dateIsMissing = Year(payDate) < Year(Now) Or (Year(payDate) = Year(Now) And Month(payDate) < Month(Now)) Or (Year(payDate) = Year(Now) And Month(payDate) = Month(Now) And Day(payDate) < Day(Now))
 If dateIsMissing Then
 removedRow = removedRow + 1
 ReDim Preserve removedIncomeRows(sourceLB2 To sourceUB2, 1 To removedRow)
 For iy = sourceLB2 To sourceUB2
 removedIncomeRows(iy, removedRow) = dataArray(ix, iy)
 Next iy
 Else
 filteredRow = filteredRow + 1
 ReDim Preserve filteredArray(sourceLB2 To sourceUB2, 1 To filteredRow)
 For iy = sourceLB2 To sourceUB2
 filteredArray(iy, filteredRow) = dataArray(ix, iy)
 Next iy
 End If
 Next ix
 Transpose2dArray filteredArray
 Transpose2dArray removedIncomeRows
 RemoveMissingPayDates = filteredArray
End Function
Public Function AddShortFallColumnToIncomeReport(ByRef incomeReportArray As Variant) As Variant
 Dim LB1 As Long, UB1 As Long
 Dim LB2 As Long, UB2 As Long
 AssignArrayBounds incomeReportArray, LB1, UB1, LB2, UB2
 Dim headerRow As Variant
 headerRow = RowFrom2dArray(incomeReportArray, LB1)
 Dim nextPayDateCol As Long, accountToDrawFromCol As Long, sippAmountCol As Long, regularAmountCol As Long
 nextPayDateCol = IndexInArray1d(headerRow, NEXT_INCOME_DATE_HEADER)
 accountToDrawFromCol = IndexInArray1d(headerRow, ACCOUNT_TO_TAKE_INCOME_FROM_HEADER)
 sippAmountCol = IndexInArray1d(headerRow, SIPP_INCOME_HEADER)
 regularAmountCol = IndexInArray1d(headerRow, REGULAR_INCOME_HEADER)
 Dim depositAccountCol As Long, reserveAccountCol As Long, incomeAccountCol As Long, tradingAccountCol As Long
 depositAccountCol = IndexInArray1d(headerRow, DEPOSIT_ACCOUNT_HEADER)
 reserveAccountCol = IndexInArray1d(headerRow, RESERVE_ACCOUNT_HEADER)
 incomeAccountCol = IndexInArray1d(headerRow, INCOME_ACCOUNT_HEADER)
 tradingAccountCol = IndexInArray1d(headerRow, TRADING_ACCOUNT_HEADER)
 UB2 = UB2 + 1
 ReDim Preserve incomeReportArray(LB1 To UB1, LB2 To UB2)
 incomeReportArray(LB1, UB2) = SHORTFALL_HEADER
 Dim shortfallCol As Long
 shortfallCol = UB2
 Dim indicatedAccount As String, accountCol As Long, accountBalance As Double
 Dim sippAmount As Double, regIncomeAmount As Double, incomeAmount As Double
 Dim outputString As String, nextPayDate As Date
 Dim ix As Long
 For ix = LB1 + 1 To UB1
 sippAmount = incomeReportArray(ix, sippAmountCol)
 regIncomeAmount = incomeReportArray(ix, regularAmountCol)
 If sippAmount > regIncomeAmount Then
 incomeAmount = sippAmount
 Else
 incomeAmount = regIncomeAmount
 End If
 indicatedAccount = incomeReportArray(ix, accountToDrawFromCol)
 Select Case indicatedAccount
 Case Is = "Deposit"
 accountCol = depositAccountCol
 Case Is = "Reserve"
 accountCol = reserveAccountCol
 Case Is = "Trading"
 accountCol = tradingAccountCol
 Case Is = "Income"
 accountCol = incomeAccountCol
 End Select
 accountBalance = incomeReportArray(ix, accountCol)
 nextPayDate = incomeReportArray(ix, nextPayDateCol)
 If accountBalance < incomeAmount And (nextPayDate - Now()) <= 14 And (nextPayDate - Now()) >= 0 Then
 outputString = "Shortfall"
 Else
 outputString = ""
 End If
 incomeReportArray(ix, shortfallCol) = outputString
 Next ix
 AddShortFallColumnToIncomeReport = incomeReportArray
End Function

Module D2_No_Model_Report

Option Explicit
Public Function GetRowsWithMissingModel(ByRef sourceArray As Variant) As Variant
 Dim ix As Long, iy As Long
 '/ Source Array
 Dim sourceLB1 As Long, sourceUB1 As Long
 Dim sourceLB2 As Long, sourceUB2 As Long
 AssignArrayBounds sourceArray, sourceLB1, sourceUB1, sourceLB2, sourceUB2
 Dim sourceHeaderRow As Variant
 sourceHeaderRow = RowFrom2dArray(sourceArray, sourceLB1)
 Dim sourceModelCol As Long
 sourceModelCol = IndexInArray1d(sourceHeaderRow, INVESTMENT_MODEL_HEADER)
 '/ Output Array
 Dim outputArray As Variant
 outputArray = InitialiseNoModelArray
 Dim outputLB1 As Long, outputUB1 As Long
 Dim outputLB2 As Long, outputUB2 As Long
 AssignArrayBounds outputArray, outputLB1, outputUB1, outputLB2, outputUB2
 Dim outputHeaderRow As Variant
 outputHeaderRow = RowFrom2dArray(outputArray, outputLB1)
 '/ Loop
 Dim header As String, sourceCol As Long
 Dim model As String, hasModel As Boolean
 Dim outputRow As Long
 Transpose2dArray sourceArray
 Transpose2dArray outputArray
 outputRow = outputLB1
 For ix = sourceLB1 + 1 To sourceUB1
 model = sourceArray(sourceModelCol, ix)
 hasModel = (model <> "" And model <> "0")
 If Not hasModel Then
 outputRow = outputRow + 1
 ReDim Preserve outputArray(outputLB2 To outputUB2, outputLB1 To outputRow)
 For iy = outputLB2 To outputUB2
 header = outputHeaderRow(iy)
 sourceCol = IndexInArray1d(sourceHeaderRow, header)
 outputArray(iy, outputRow) = sourceArray(sourceCol, ix)
 Next iy
 End If
 Next ix
 Transpose2dArray sourceArray
 Transpose2dArray outputArray
 GetRowsWithMissingModel = outputArray
End Function

Module D3_Uninvested_Cash_Report

Option Explicit
Public Function GetUninvestedCashReport(ByRef sourceArray As Variant) As Variant
 Dim ix As Long, iy As Long
 '/ Source Array
 Dim sourceLB1 As Long, sourceUB1 As Long
 Dim sourceLB2 As Long, sourceUB2 As Long
 AssignArrayBounds sourceArray, sourceLB1, sourceUB1, sourceLB2, sourceUB2
 Dim sourceHeaderRow As Variant
 sourceHeaderRow = RowFrom2dArray(sourceArray, sourceLB1)
 '/ Output Array
 Dim outputArray As Variant
 outputArray = InitialiseUninvestedCashArray
 Dim outputLB1 As Long, outputUB1 As Long
 Dim outputLB2 As Long, outputUB2 As Long
 AssignArrayBounds outputArray, outputLB1, outputUB1, outputLB2, outputUB2
 Dim outputHeaderRow As Variant
 outputHeaderRow = RowFrom2dArray(outputArray, outputLB1)
 '/ Loop
 Dim header As String, sourceCol As Long
 Dim outputRow As Long
 Transpose2dArray sourceArray
 Transpose2dArray outputArray
 outputRow = outputLB1
 For ix = sourceLB1 + 1 To sourceUB1
 outputRow = outputRow + 1
 ReDim Preserve outputArray(outputLB2 To outputUB2, outputLB1 To outputRow)
 For iy = outputLB2 To outputUB2
 header = outputHeaderRow(iy)
 sourceCol = IndexInArray1d(sourceHeaderRow, header)
 outputArray(iy, outputRow) = sourceArray(sourceCol, ix)
 Next iy
 Next ix
 Transpose2dArray sourceArray
 Transpose2dArray outputArray
 GetUninvestedCashReport = outputArray
End Function
Public Function AppendDepositPercentOfWrapper(sourceArray) As Variant
 '/ source
 Dim sourceLB1 As Long, sourceUB1 As Long
 Dim sourceLB2 As Long, sourceUB2 As Long
 AssignArrayBounds sourceArray, sourceLB1, sourceUB1, sourceLB2, sourceUB2
 ReDim Preserve sourceArray(sourceLB1 To sourceUB1, sourceLB2 To sourceUB2 + 1)
 sourceUB2 = sourceUB2 + 1
 sourceArray(sourceLB1, sourceUB2) = DEPOSIT_PERCENT_OF_WRAPPER_HEADER
 Dim sourceHeaderRow As Variant
 sourceHeaderRow = RowFrom2dArray(sourceArray, sourceLB1)
 Dim sourceDepositPercentCol As Long
 sourceDepositPercentCol = sourceUB2
 Dim sourceWrapperCol As Long, sourceDepositCol As Long
 sourceWrapperCol = IndexInArray1d(sourceHeaderRow, WRAPPER_VALUE_HEADER)
 sourceDepositCol = IndexInArray1d(sourceHeaderRow, DEPOSIT_ACCOUNT_HEADER)
 Dim ix As Long
 Dim wrapperValue As Double, depositValue As Double, percentValue As Double
 For ix = sourceLB1 + 1 To sourceUB1
 wrapperValue = sourceArray(ix, sourceWrapperCol)
 depositValue = sourceArray(ix, sourceDepositCol)
 If wrapperValue > 0 Then
 percentValue = depositValue / wrapperValue
 sourceArray(ix, sourceDepositPercentCol) = percentValue
 End If
 Next ix
 AppendDepositPercentOfWrapper = sourceArray
End Function
Public Function GetAccountsAboveThresholdValue(ByRef sourceArray As Variant, ByVal minimumValue As Double) As Variant
 Dim ix As Long, iy As Long
 '/ Source Array
 Dim sourceLB1 As Long, sourceUB1 As Long
 Dim sourceLB2 As Long, sourceUB2 As Long
 AssignArrayBounds sourceArray, sourceLB1, sourceUB1, sourceLB2, sourceUB2
 Dim sourceHeaderRow As Variant
 sourceHeaderRow = RowFrom2dArray(sourceArray, sourceLB1)
 Dim sourceWrapperCol As Long
 sourceWrapperCol = IndexInArray1d(sourceHeaderRow, WRAPPER_VALUE_HEADER)
 '/ Output Array
 Dim outputArray As Variant
 outputArray = InitialiseUninvestedCashArray
 Dim outputLB1 As Long, outputUB1 As Long
 Dim outputLB2 As Long, outputUB2 As Long
 AssignArrayBounds outputArray, outputLB1, outputUB1, outputLB2, outputUB2
 outputUB2 = outputUB2 + 1
 ReDim Preserve outputArray(outputLB1 To outputUB1, outputLB2 To outputUB2)
 outputArray(outputLB1, outputUB2) = DEPOSIT_PERCENT_OF_WRAPPER_HEADER
 Dim outputHeaderRow As Variant
 outputHeaderRow = RowFrom2dArray(outputArray, outputLB1)
 '/ Loop
 Dim header As String, sourceCol As Long
 Dim wrapper As Double
 Dim outputRow As Long
 Transpose2dArray sourceArray
 Transpose2dArray outputArray
 outputRow = outputLB1
 For ix = sourceLB1 + 1 To sourceUB1
 wrapper = sourceArray(sourceWrapperCol, ix)
 If wrapper >= minimumValue Then
 outputRow = outputRow + 1
 ReDim Preserve outputArray(outputLB2 To outputUB2, outputLB1 To outputRow)
 For iy = outputLB2 To outputUB2
 header = outputHeaderRow(iy)
 sourceCol = IndexInArray1d(sourceHeaderRow, header)
 outputArray(iy, outputRow) = sourceArray(sourceCol, ix)
 Next iy
 End If
 Next ix
 Transpose2dArray sourceArray
 Transpose2dArray outputArray
 GetAccountsAboveThresholdValue = outputArray
End Function

Module E5_Visual_Formatting

I've removed this module because it is the least complex (lots of column formatting, row colouring, area bordering etc.) and because I was hitting the character limit.

Module B2_Project_Settings_And_Methods

Option Explicit
Public Function InitialiseNoModelArray() As Variant
 Dim noModelArray As Variant
 noModelArray = Array()
 ReDim noModelArray(1 To 1, 1 To 4)
 noModelArray(1, 1) = CLIENT_NAME_HEADER
 noModelArray(1, 2) = ASCENTRIC_NUMBER_HEADER
 noModelArray(1, 3) = PRODUCT_CODE_HEADER
 noModelArray(1, 4) = WRAPPER_VALUE_HEADER
 InitialiseNoModelArray = noModelArray
End Function
Public Function InitialiseUninvestedCashArray() As Variant
 Dim uninvestedCashArray As Variant
 uninvestedCashArray = Array()
 ReDim uninvestedCashArray(1 To 1, 1 To 6)
 uninvestedCashArray(1, 1) = ADVISER_NAME_HEADER
 uninvestedCashArray(1, 2) = CLIENT_NAME_HEADER
 uninvestedCashArray(1, 3) = ASCENTRIC_NUMBER_HEADER
 uninvestedCashArray(1, 4) = PRODUCT_CODE_HEADER
 uninvestedCashArray(1, 5) = WRAPPER_VALUE_HEADER
 uninvestedCashArray(1, 6) = DEPOSIT_ACCOUNT_HEADER
 InitialiseUninvestedCashArray = uninvestedCashArray
End Function
Public Function ConvertLuminIncomeToAscentricIncomeFormat(ByRef luminIncomeDataArray As Variant) As Variant
'/ Payment day/ Base month --> Next pay date.
 Dim convertedArray As Variant
 convertedArray = Array()
 CopyArrayContents2d luminIncomeDataArray, convertedArray
 Dim LB1 As Long, UB1 As Long
 Dim LB2 As Long, UB2 As Long
 AssignArrayBounds luminIncomeDataArray, LB1, UB1, LB2, UB2
 '/ Convert Headers
 Dim oldHeader As String, newHeader As String
 Dim headerRow As Long, iy As Long
 headerRow = LB1
 For iy = LB2 To UB2
 oldHeader = luminIncomeDataArray(headerRow, iy)
 Select Case oldHeader
 Case Is = WsIncClientNameHeader
 newHeader = CLIENT_NAME_HEADER
 Case Is = WsIncIncomeAmountHeader
 newHeader = REGULAR_INCOME_HEADER
 Case Is = WsIncPaymentFrequencyHeader
 newHeader = INCOME_FREQUENCY_HEADER
 Case Is = WsIncAscentricWrapperHeader
 newHeader = PRODUCT_CODE_HEADER
 Case Is = WsIncAscentricAccountNumberHeader
 newHeader = ASCENTRIC_NUMBER_HEADER
 Case Is = WsIncAccountToPayFromHeader
 newHeader = ACCOUNT_TO_TAKE_INCOME_FROM_HEADER
 Case Is = WsIncNextIncomeDateHeader
 newHeader = NEXT_INCOME_DATE_HEADER
 Case Else
 newHeader = oldHeader
 End Select
 convertedArray(headerRow, iy) = newHeader
 Next iy
 '/ Add missing Columns
 ReDim Preserve convertedArray(LB1 To UB1, LB2 To UB2 + 5) '/ +5 for missing columns
 convertedArray(headerRow, UB2 + 1) = DEPOSIT_ACCOUNT_HEADER
 convertedArray(headerRow, UB2 + 2) = RESERVE_ACCOUNT_HEADER
 convertedArray(headerRow, UB2 + 3) = INCOME_ACCOUNT_HEADER
 convertedArray(headerRow, UB2 + 4) = TRADING_ACCOUNT_HEADER
 convertedArray(headerRow, UB2 + 5) = SIPP_INCOME_HEADER
 ConvertLuminIncomeToAscentricIncomeFormat = convertedArray
End Function
Public Function GetAscentricHeaders() As Collection
 Dim col As Collection
 Set col = New Collection
 col.Add ADVISER_NAME_HEADER
 col.Add CLIENT_NAME_HEADER
 col.Add ASCENTRIC_NUMBER_HEADER
 col.Add PRODUCT_CODE_HEADER
 col.Add WRAPPER_VALUE_HEADER
 col.Add INVESTMENT_MODEL_HEADER
 col.Add DEPOSIT_ACCOUNT_HEADER
 col.Add RESERVE_ACCOUNT_HEADER
 col.Add INCOME_ACCOUNT_HEADER
 col.Add TRADING_ACCOUNT_HEADER
 col.Add SIPP_INCOME_HEADER
 col.Add REGULAR_INCOME_HEADER
 col.Add INCOME_FREQUENCY_HEADER
 col.Add ACCOUNT_TO_TAKE_INCOME_FROM_HEADER
 col.Add NEXT_INCOME_DATE_HEADER
 Set GetAscentricHeaders = col
End Function
Public Function GetClientIncomeHeaders() As Collection
 Dim col As Collection
 Set col = New Collection
 col.Add WsIncClientNameHeader
 col.Add REGULAR_INCOME_HEADER
 col.Add INCOME_FREQUENCY_HEADER
 col.Add WsIncPaymentDayHeader
 col.Add WsIncBaseMonthHeader
 col.Add PRODUCT_CODE_HEADER
 col.Add ASCENTRIC_NUMBER_HEADER
 col.Add ACCOUNT_TO_TAKE_INCOME_FROM_HEADER
 col.Add NEXT_INCOME_DATE_HEADER
 col.Add DEPOSIT_ACCOUNT_HEADER
 col.Add RESERVE_ACCOUNT_HEADER
 col.Add INCOME_ACCOUNT_HEADER
 col.Add TRADING_ACCOUNT_HEADER
 col.Add SIPP_INCOME_HEADER
 Set GetClientIncomeHeaders = col
End Function
Public Function InitialiseIncomeReportColumnNumbers() As Scripting.Dictionary
 Dim dict As Scripting.Dictionary
 Set dict = New Scripting.Dictionary
 Dim header As String, colNum As Long
 header = ADVISER_NAME_HEADER
 colNum = 1
 dict.Add header, colNum
 header = CLIENT_NAME_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = ASCENTRIC_NUMBER_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = PRODUCT_CODE_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = RESERVE_ACCOUNT_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = DEPOSIT_ACCOUNT_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = INCOME_ACCOUNT_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = TRADING_ACCOUNT_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = ACCOUNT_TO_TAKE_INCOME_FROM_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = SIPP_INCOME_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = REGULAR_INCOME_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = INCOME_FREQUENCY_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = NEXT_INCOME_DATE_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 Set InitialiseIncomeReportColumnNumbers = dict
End Function
Public Function InitialiseIncomeArray() As Variant
 Dim dataArray As Variant
 dataArray = Array()
 Dim minCol As Long, maxCol As Long, colNum As Long
 Dim key As Variant
 Dim isFirstKey As Boolean
 isFirstKey = True
 For Each key In IncomeReportColumnNumbers.Keys()
 colNum = IncomeReportColumnNumbers.item(key)
 If isFirstKey Then
 minCol = colNum
 isFirstKey = False
 End If
 If colNum > maxCol Then maxCol = colNum
 If colNum < minCol Then minCol = colNum
 Next key
 ReDim dataArray(1 To 1, minCol To maxCol)
 Dim header As String
 For Each key In IncomeReportColumnNumbers.Keys()
 header = key
 colNum = IncomeReportColumnNumbers.item(key)
 dataArray(1, colNum) = header
 Next key
 InitialiseIncomeArray = dataArray
End Function
Public Function MergeIncomeArrays(ByRef primaryArray As Variant, ByRef secondaryArray As Variant) As Variant
 Dim mergedArray As Variant
 mergedArray = InitialiseIncomeArray()
 Dim unidHeader As String
 unidHeader = ASCENTRIC_NUMBER_HEADER
 '/ From this point on, all operations defined in terms of source/target arrays
 mergedArray = AddOrMergeIntoArray(primaryArray, mergedArray, unidHeader, PRODUCT_CODE_HEADER, NEXT_INCOME_DATE_HEADER)
 mergedArray = AddOrMergeIntoArray(secondaryArray, mergedArray, unidHeader, PRODUCT_CODE_HEADER, NEXT_INCOME_DATE_HEADER)
 MergeIncomeArrays = mergedArray
End Function
Public Function AddOrMergeIntoArray(ByRef sourceArray As Variant, ByRef targetArray As Variant, ByVal firstUnidHeader As String, ByVal secondUnidHeader As String, ByVal thirdUnidHeader As String) As Variant
'/ Assumptions: Headers are always in the lowest row of an Array
'/ The headers in the source Array are a strict subset of the headers in the larger Array
'/ Values "", 0 and vbNullString represent empty data to be replaced
 Dim unidsInReport As Scripting.Dictionary
 Set unidsInReport = New Scripting.Dictionary
 Dim sourceHeaderRow As Variant, targetHeaderRow As Variant
 Dim sourceFirstUnidColNum As Long, targetFirstUnidColNum As Long
 Dim sourceSecondUnidColNum As Long, targetSecondUnidColNum As Long
 Dim sourceThirdUnidColNum As Long, targetThirdUnidColNum As Long
 Dim sourceValue As Variant, targetValue As Variant
 Dim sourceRow As Long, targetRow As Long
 Dim sourceColumn As Long, targetColumn As Long
 Dim sourceLB1 As Long, sourceUB1 As Long
 Dim sourceLB2 As Long, sourceUB2 As Long
 AssignArrayBounds sourceArray, sourceLB1, sourceUB1, sourceLB2, sourceUB2
 Dim targetLB1 As Long, targetUB1 As Long
 Dim targetLB2 As Long, targetUB2 As Long
 AssignArrayBounds targetArray, targetLB1, targetUB1, targetLB2, targetUB2
 sourceHeaderRow = RowFrom2dArray(sourceArray, sourceLB1)
 targetHeaderRow = RowFrom2dArray(targetArray, targetLB1)
 sourceFirstUnidColNum = IndexInArray1d(sourceHeaderRow, firstUnidHeader)
 targetFirstUnidColNum = IndexInArray1d(targetHeaderRow, firstUnidHeader)
 sourceSecondUnidColNum = IndexInArray1d(sourceHeaderRow, secondUnidHeader)
 targetSecondUnidColNum = IndexInArray1d(targetHeaderRow, secondUnidHeader)
 sourceThirdUnidColNum = IndexInArray1d(sourceHeaderRow, thirdUnidHeader)
 targetThirdUnidColNum = IndexInArray1d(targetHeaderRow, thirdUnidHeader)
 Dim firstUnid As String, secondUnid As String, thirdUnid As String
 Dim unid As String, header As String
 Dim ix As Long, iy As Long
 '/ add unids to dictionary
 For ix = targetLB1 + 1 To targetUB1 '/ +1 for headers
 firstUnid = targetArray(ix, targetFirstUnidColNum)
 secondUnid = targetArray(ix, targetSecondUnidColNum)
 thirdUnid = CStr(targetArray(ix, targetThirdUnidColNum))
 unid = firstUnid & ";" & secondUnid & ";" & thirdUnid
 unidsInReport.Add unid, ix
 Next ix
 Transpose2dArray targetArray
 '/ Add or Merge
 For ix = sourceLB1 + 1 To sourceUB1
 firstUnid = sourceArray(ix, sourceFirstUnidColNum)
 secondUnid = sourceArray(ix, sourceSecondUnidColNum)
 thirdUnid = CStr(sourceArray(ix, sourceThirdUnidColNum))
 unid = firstUnid & ";" & secondUnid & ";" & thirdUnid
 sourceRow = ix
 If unidsInReport.Exists(unid) Then
 targetRow = unidsInReport.item(unid)
 Else
 targetRow = UBound(targetArray, 2) + 1 '/ currently transposed so 2nd dimension = rows
 ReDim Preserve targetArray(targetLB2 To targetUB2, 1 To targetRow)
 End If
 For iy = sourceLB2 To sourceUB2
 header = sourceHeaderRow(iy)
 sourceColumn = iy
 targetColumn = IndexInArray1d(targetHeaderRow, header)
 sourceValue = sourceArray(sourceRow, sourceColumn)
 If unidsInReport.Exists(unid) Then
 targetValue = targetArray(targetColumn, targetRow) '/ currently transposed
 If targetValue = vbNullString Or targetValue = "" Or targetValue = 0 Then
 targetArray(targetColumn, targetRow) = sourceValue
 End If
 Else
 targetArray(targetColumn, targetRow) = sourceValue
 End If
 Next iy
 Next ix
 Transpose2dArray targetArray
 AddOrMergeIntoArray = targetArray
End Function
Public Function AppendNotes(ByRef targetArray As Variant, ByRef notesArray As Variant) As Variant
 '/ notes
 Dim notesLB1 As Long, notesUB1 As Long
 Dim notesLB2 As Long, notesUB2 As Long
 AssignArrayBounds notesArray, notesLB1, notesUB1, notesLB2, notesUB2
 Dim notesHeaderRow As Variant
 notesHeaderRow = RowFrom2dArray(notesArray, notesLB1)
 Dim notesNotesCol As Long
 notesNotesCol = IndexInArray1d(notesHeaderRow, NOTES_HEADER)
 Dim notesAccountCol As Long, notesProductCol As Long
 notesAccountCol = IndexInArray1d(notesHeaderRow, ASCENTRIC_NUMBER_HEADER)
 notesProductCol = IndexInArray1d(notesHeaderRow, PRODUCT_CODE_HEADER)
 '/ target
 Dim targetLB1 As Long, targetUB1 As Long
 Dim targetLB2 As Long, targetUB2 As Long
 AssignArrayBounds targetArray, targetLB1, targetUB1, targetLB2, targetUB2
 ReDim Preserve targetArray(targetLB1 To targetUB1, targetLB2 To targetUB2 + 1)
 targetUB2 = targetUB2 + 1
 targetArray(targetLB1, targetUB2) = NOTES_HEADER
 Dim targetHeaderRow As Variant
 targetHeaderRow = RowFrom2dArray(targetArray, targetLB1)
 Dim targetNotesCol As Long
 targetNotesCol = IndexInArray1d(targetHeaderRow, NOTES_HEADER)
 Dim targetAccountCol As Long, targetProductCol As Long
 targetAccountCol = IndexInArray1d(targetHeaderRow, ASCENTRIC_NUMBER_HEADER)
 targetProductCol = IndexInArray1d(targetHeaderRow, PRODUCT_CODE_HEADER)
 Dim ix As Long
 Dim i As Long
 Dim accountNum As String, product As String
 Dim targetUnid As String, notesUnid As String
 For ix = notesLB1 + 1 To notesUB1
 accountNum = notesArray(ix, notesAccountCol)
 product = notesArray(ix, notesProductCol)
 notesUnid = accountNum & ";" & product
 For i = notesLB1 To notesUB1
 accountNum = targetArray(i, targetAccountCol)
 product = targetArray(i, targetProductCol)
 targetUnid = accountNum & ";" & product
 If targetUnid = notesUnid Then
 targetArray(i, targetNotesCol) = notesArray(ix, notesNotesCol)
 End If
 Next i
 Next ix
 AppendNotes = targetArray
End Function
asked Jan 15, 2016 at 20:12
\$\endgroup\$
4
  • \$\begingroup\$ 'StoreApplicationSettings' and 'RestoreApplicationSettings' are things you wrote but didn't include on purpose, yes? It would be useful to identify all of the ones like that. I don't know what N.B. is. Also your Getxx functions? \$\endgroup\$ Commented Jan 19, 2016 at 17:39
  • \$\begingroup\$ You don't have any error handling or you didn't include it? \$\endgroup\$ Commented Jan 19, 2016 at 17:47
  • \$\begingroup\$ @Raystafarian The code is presented as-is. \$\endgroup\$ Commented Jan 19, 2016 at 18:38
  • \$\begingroup\$ @Raystafarian N.B. "Nota Bene", basically "Stuff you should know". \$\endgroup\$ Commented Jan 22, 2016 at 13:04

2 Answers 2

7
+200
\$\begingroup\$

I think you should work on cleaning the small bits of your code through the use of small functions.

 If sippAmount > regIncomeAmount Then
 incomeAmount = sippAmount
 Else
 incomeAmount = regIncomeAmount
 End If

Like here, I don't know what the VBA call is, but isn't there some version of MAX that you could use?

Or here,

Public Function InitialiseIncomeReportColumnNumbers() As Scripting.Dictionary
 Dim dict As Scripting.Dictionary
 Set dict = New Scripting.Dictionary
 Dim header As String, colNum As Long
 header = ADVISER_NAME_HEADER
 colNum = 1
 dict.Add header, colNum
 header = CLIENT_NAME_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = ASCENTRIC_NUMBER_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = PRODUCT_CODE_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = RESERVE_ACCOUNT_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = DEPOSIT_ACCOUNT_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = INCOME_ACCOUNT_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = TRADING_ACCOUNT_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = ACCOUNT_TO_TAKE_INCOME_FROM_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = SIPP_INCOME_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = REGULAR_INCOME_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = INCOME_FREQUENCY_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 header = NEXT_INCOME_DATE_HEADER
 colNum = colNum + 1
 dict.Add header, colNum
 Set InitialiseIncomeReportColumnNumbers = dict
End Function

Can't you make a separate addAll function that takes a bunch of values (all your headers) and handles the colNum crap for you?

Or this one, where you're replacing some specific strings in CleanUpAscentricData

valueToReplace = "AGENERAL"
replacementValue = "GIA"
ascentricDataArray = FindAndReplace2DArrayValues(ascentricDataArray, valueToReplace, replacementValue)
valueToReplace = "AGENERAL2"
replacementValue = "GIA2"
ascentricDataArray = FindAndReplace2DArrayValues(ascentricDataArray, valueToReplace, replacementValue)
valueToReplace = "AGENERAL3"
replacementValue = "GIA3"
ascentricDataArray = FindAndReplace2DArrayValues(ascentricDataArray, valueToReplace, replacementValue)
valueToReplace = "AGENERAL4"
replacementValue = "GIA4"
ascentricDataArray = FindAndReplace2DArrayValues(ascentricDataArray, valueToReplace, replacementValue)

and CleanUpNotesData:

valueToReplace = "AGENERAL"
replacementValue = "GIA"
notesDataArray = FindAndReplace2DArrayValues(notesDataArray, valueToReplace, replacementValue)
valueToReplace = "AGENERAL2"
replacementValue = "GIA2"
notesDataArray = FindAndReplace2DArrayValues(notesDataArray, valueToReplace, replacementValue)
valueToReplace = "AGENERAL3"
replacementValue = "GIA3"
notesDataArray = FindAndReplace2DArrayValues(notesDataArray, valueToReplace, replacementValue)
valueToReplace = "AGENERAL4"
replacementValue = "GIA4"
notesDataArray = FindAndReplace2DArrayValues(notesDataArray, valueToReplace, replacementValue)

Looks like a good place for a generic helper function to me. Array + a mapping of "from, to" goes in, array with replaced values comes out.

Here's another one...

Dim ws As Worksheet
Dim arr As Variant
Set ws = wsClientIncomeReport
arr = incomeReportArray
ws.Cells.Clear
Print2dArrayToSheet wbUninvestedCash, ws, arr, ws.Cells(1, 1)
FormatIncomeReportVisuals arr, ws
Set ws = wsRemovedIncome
arr = removedIncomeRows
ws.Cells.Clear
Print2dArrayToSheet wbUninvestedCash, ws, arr, ws.Cells(1, 1)
FormatIncomeReportVisuals arr, ws
Set ws = wsNoModelAttachedreport
arr = noModelArray
ws.Cells.Clear
Print2dArrayToSheet wbUninvestedCash, ws, arr, ws.Cells(1, 1)
FormatNoModelReportVisuals arr, ws
Set ws = wsUninvestedCashReport
arr = uninvestedCashReport
ws.Cells.Clear
Print2dArrayToSheet wbUninvestedCash, ws, arr, ws.Cells(1, 1)
FormatUninvestedCashReportVisuals arr, ws

You're doing something that looks very much the same 4 times in a row. Would it be possible to just pass the values into a function?

Or there's here

 If header = ADVISER_NAME_HEADER Then
 If hasAdviser Then
 value = dataArray(ix, sourceColNum)
 newArr(iy, currentRow) = value
 End If
 Else
 value = dataArray(ix, sourceColNum)
 newArr(iy, currentRow) = value
 End If

Where you do something if (A && B) || !A... if we make a truth table out of that, we can see that...

a: header = ADVISER_NAME_HEADER 
b: hasAdviser
a | b | a && b | !a | (a && b) or !a
====================================
0 | 0 | 0 | 1 | 1
0 | 1 | 0 | 1 | 1
1 | 0 | 0 | 0 | 0
1 | 1 | 1 | 0 | 1

Only the case (a and not b) results in a false case. So if we invert it to "if not A or b", it simplifies the condition. This way you only have 1 case where you need to copy a value, rather than 3.

You should also take a look at the flow of execution, there's certain places where you do things only to throw them away.

Like here, 

For ix = sourceLB1 + 1 To sourceUB1
 wrapperValue = sourceArray(ix, sourceWrapperCol)
 depositValue = sourceArray(ix, sourceDepositCol)
 If wrapperValue > 0 Then
 percentValue = depositValue / wrapperValue
 sourceArray(ix, sourceDepositPercentCol) = percentValue
 End If
Next ix

No need to fill depositValue if the if check is not going to succeed, so better move that like so:

For ix = sourceLB1 + 1 To sourceUB1
 wrapperValue = sourceArray(ix, sourceWrapperCol)
 If wrapperValue > 0 Then
 depositValue = sourceArray(ix, sourceDepositCol)
 percentValue = depositValue / wrapperValue
 sourceArray(ix, sourceDepositPercentCol) = percentValue
 End If
Next ix

Talked about this earlier, the hasAdviser thing:

 sourceColNum = columnNumbers.item(header)
 If header = ADVISER_NAME_HEADER Then
 If hasAdviser Then
 value = dataArray(ix, sourceColNum)
 newArr(iy, currentRow) = value
 End If
 Else
 value = dataArray(ix, sourceColNum)
 newArr(iy, currentRow) = value
 End If

If we simplify to 

 sourceColNum = columnNumbers.item(header)
 If Not header = ADVISER_NAME_HEADER OR hasAdviser Then '/ Replace with appropriate syntax
 value = dataArray(ix, sourceColNum)
 newArr(iy, currentRow) = value
 End If

Then we can relocate the sourceColNum variable...

 If Not header = ADVISER_NAME_HEADER OR hasAdviser Then '/ Replace with appropriate syntax
 sourceColNum = columnNumbers.item(header)
 value = dataArray(ix, sourceColNum)
 newArr(iy, currentRow) = value
 End If

And that saves another bit. We could even eliminate the value variable:

 If Not header = ADVISER_NAME_HEADER OR hasAdviser Then '/ Replace with appropriate syntax
 sourceColNum = columnNumbers.item(header)
 newArr(iy, currentRow) = dataArray(ix, sourceColNum)
 End If

Because all it serves as is a local store to help "explain" the code, but value is not a very helpful descriptor.

Dim header As String
For Each key In IncomeReportColumnNumbers.Keys()
 header = key
 colNum = IncomeReportColumnNumbers.item(key)
 dataArray(1, colNum) = header
Next key

Here you make a new variable just so you can locally store to it... why not name your "key" "header" in the first place?

answered Jan 20, 2016 at 11:10
\$\endgroup\$
1
  • 5
    \$\begingroup\$ I think this is a great example of someone tackling a syntax they aren't too familiar with and presenting ideas that are common across syntaxes. \$\endgroup\$ Commented Jan 20, 2016 at 17:50
2
\$\begingroup\$

I know I sort-of mentioned them in my previous answer, but as your project grows I think it's becoming a greater concern.

I don't get the prefixes. Looks like some arbitrary naming scheme to work around the alphabetical sorting of modules in the VBA project explorer.

  • B1_Public_Variables
  • B2_Project_Settings_And_Methods
  • C1_Main_Sub
  • C2_Get_Data_Ranges
  • C3_Get_Data_Arrays
  • C4_Get_Column_Indexes
  • C5_Clean_Array_Data
  • D1_Income_Report
  • D2_No_Model_Report
  • D3_Uninvested_Cash_Report
  • E1_???
  • E2_???
  • E3_???
  • E4_???
  • E5_Visual_Formatting

So, I want to call a function in the income report module. So I type Inco and notice IntelliSense is completely useless, so I try Repor and notice nothing comes up either. Then I have to remember was it C or D, or perhaps E?, and I don't, so I end up scrolling the whole list of everything, get frustrated, bring up the Project Explorer, and find it under D1_Income_Report. Geez.

You wouldn't name variables B1, B2, C1, C2, C3 would you? Well the same applies to modules: if you think you need to number them, you're doing it wrong.

B1_Public_Variables

I like how the module says public variables, and only exposes constants, most of which have to do with column headings which are likely shared between the various reports, and then you start dumping things that clearly don't belong there:

'/ Headers for Client Income workbook

Why isn't there an abstraction for this client income workbook? It seems to be an important piece of the puzzle, and yet it doesn't get its own module.

The other public variables are troubling:

'/ Income Report
'/ Uninvested Cash Report

These reports do have their own module. Why are there public variables and constants for them in this module? What else is coming into this B1_Public_Variables module in the future then?

The problem is that a module called PublicVariables is only ever going to end up like that. Would there be any report-specific globals in there, if the module was called SharedColumnHeadings? Give each module a purpose, and stick to it.

I notice quite a bunch of modules that really expose only a single (or two/three very similar) function.. and they're named like functions, too. A module name that starts with a verb, smells. You're scattering related functionality across multiple similarly-named modules, each exposing a few methods.

I think the biggest problem I'm seeing with your code, is that you need to rework the abstractions, it's lacking structure. Make an interface that clearly states what a report should be doing, then implement it with a class for each report; and the common code /functionality will simply emerge.

answered Jan 24, 2016 at 18:27
\$\endgroup\$

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.