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
\$\endgroup\$
  • \$\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\$ – Raystafarian Jan 19 '16 at 17:39
  • \$\begingroup\$ You don't have any error handling or you didn't include it? \$\endgroup\$ – Raystafarian Jan 19 '16 at 17:47
  • \$\begingroup\$ @Raystafarian The code is presented as-is. \$\endgroup\$ – Kaz Jan 19 '16 at 18:38
  • \$\begingroup\$ @Raystafarian N.B. "Nota Bene", basically "Stuff you should know". \$\endgroup\$ – Kaz Jan 22 '16 at 13:04
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?

\$\endgroup\$
  • 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\$ – Raystafarian Jan 20 '16 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.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.