Aggregating data from multiple worksheets into a consistent format

Question

First off, this is the 3rd (and probably last) review of the project in question. You can find the previous question here.

The Macro accesses a workbook containing 8 worksheets each with similarly structured but not identical tables of data (submitted business for my company). It then filters this data for desired columns and aggregates it into a separate workbook.

As before, I'd like advice/feedback on improving the following:

• Readability: Ability for somebody who is not me to come in blind, and (relatively) easily figure out how the whole thing works and fix some problem that's cropped up.

• Robustness: Designing subs/functions to deal with variable cases and/or to reliably fail when given unintended arguments.

• Reusability: Designing subs/functions/the entire project so they can be easily re-purposed for future projects.

What Changed: The order in which the Macro does things is roughly the same, there's been a significant amount of further refactoring, renaming subs/functions/variables and general incorporating of previous advice.

Since this is (hopefully) the end of this particular project, I would also appreciate feedback on what I'm doing right.

Module 1: M1_Public_Variables_Constants

N.B. I'm aware that making all the declarations line up like this isn't an efficient use of time, but since it's already been done, I'm not about to go and spend more time deliberately undoing it.

Option Explicit
Option Compare Text

'/ Workbooks
Public WbSubsheet                                   As Workbook     '/ Contains all Lumin Wealth submitted Business
Public WbAdviserReport                              As Workbook     '/ Will Contain an aggregation of the subsheet and a submission report (by month) for each adviser

'/ Adviser Report worksheets
Public WsAggregatedData                             As Worksheet    '/ Will contain the aggregated subsheet data
Public WsAdviserReport                              As Worksheet    '/ Will contain the submissions report, reported by Adviser
Public WsProviderReport                             As Worksheet    '/ Will contain the submissions report, reported by Provider
Public WsProductReport                              As Worksheet    '/ Will contain the submissions report, reportrd by Type of Business
Public WsChangedData                                As Worksheet    '/ Record of Data CleanUp

'/ Subsheet Worksheets
Public WsNewClient                                  As Worksheet    '/ 'New Client' Investments of Assets
Public WsExistingClient                             As Worksheet    '/ 'Existing Client' Investments of assets
Public WsGroupSchemes                               As Worksheet    '/ 'e.g. Corporate pension schemes and/or Auto Enrolment
Public WsOther                                      As Worksheet    '/ Misc. bits and pieces
Public WsMcOngoing                                  As Worksheet    '/ Martin's recurring product commissions e.g. insurance policies
Public WsJhOngoing                                  As Worksheet    '/ Jon's recurring product commissions e.g. insurance policies
Public WsAegonQuilterArc                            As Worksheet    '/ Recurring fees from accounts with Aegon, Quilter and ARC
Public WsAscentric                                  As Worksheet    '/ Recurring fees from accounts on Asccentric

'/ Data Arrays
Public ArrAggregatedArrays                          As Variant      '/ Holds all the sheet-Data Arrays

Public ArrAggregatedData                            As Variant      '/ The data from all worksheets

Public ArrProviders                                 As Variant      '/ all providers found in the subsheet
Public ArrAdvisers                                  As Variant      '/ all the advisers found in the subsheet

'/ Collections of names
Public ColAllHeadings                               As Collection   '/ All desired Column Headings from the subsheet
Public ColMetrics                                   As Collection   '/ Metrics in the final report
Public colAdviserNames                              As Collection   '/ All Adviser names that MIGHT be in the Subsheet

'/ Constants, and variables that are only set once
Public StrCurrentDate               As String           '/  The current Date for datestamping the saved report
Public StrSavedReportFilename       As String           '/  The filename to save the report as

Public LngFinalCellRow      As Long
Public LngFinalCellColumn   As Long

Public Const StrAdviserReportFilePath               As String = "S:\Lumin Admin Docs\Adviser Submission Reports\"               '/  The path of the folder containing the Adviser Report
Public Const StrSavedReportsFilePath                As String = "S:\Lumin Admin Docs\Adviser Submission Reports\Saved Reports\" '/  The path of the folder containing previous reports
Public Const StrSubsheetFilePath                    As String = "S:\Lumin Admin Docs\Subsheet and Commission statements\"       '/  The path of the folder containing the Subsheet

Public Const StrAdviserReportFilename               As String = "Adviser Submissions Report - v0.5.xlsm"                        '/  The filename of the Adviser Submissions Report
Public Const StrSubsheetFilename                    As String = "Lumin Subsheet 2015.xlsm"                                      '/  The filename of the Subsheet

Public Const Hyphen As String = " - "

Public varScreenUpdating    As Boolean
Public varEnableEvents      As Boolean
Public varCalculation       As XlCalculation

Modules 2 - 4:

M2_Main_Subs

M3_Auxilary_Subs

M4_Manual_Settings

I elected to present them here in rough order of execution, as opposed to by Module. Any Sub/Function that isn't here will be in the Standard_Methods Module at the end.

GenerateAdviserSubmissionReports()

The initial sub to be run by the end user.

Public Sub GenerateAdviserSubmissionReports()

    StoreApplicationSettings
    
    DisableApplicationSettings
    
    '/======================================================================================================================================================
    '/  Author:  Zak Armstrong
    '/  Email:   [email protected]
    '/  Date:    21/August/2015
    '/  Version: 0.3
    '/
    '/  Description:    All Lumin Wealth Business is contained in the Subsheet. This macro produces adviser totals for business (assets and fees) in the previous year
    '/                  (month by month breakdown) by aggregating the subsheet into one giant table and then assigning each piece of business to an adviser, a Month and a business type.
    '/                  The report can then be easily configured for any desired outputs (E.G. by adviser, by provider, by type of business)
    '/======================================================================================================================================================
    '/======================================================================================================================================================
        InitialiseGlobalsBooksSheetsAndCollections
        
        GetAllSheetDataIntoArrays
        
        FilterSheetArrays
        
        AggregateSheetData
        
        CloseWorkbook WbSubsheet

        PrintAggregatedData
        
        CleanUpAggregatedData
        
    RestoreApplicationSettings

End Sub

InitialiseGlobalsBooksSheetsAndCollections

Set all the Globals, Collections etc. for the rest of the project.

Public Sub InitialiseGlobalsBooksSheetsAndCollections()

        Sheets(1).Activate
        LngFinalCellRow = Sheets(1).Rows.Count
        LngFinalCellColumn = Sheets(1).Columns.Count
        
    '/ initialise public arrays
        ArrAggregatedData = Array()
        ArrAggregatedArrays = Array()
        ArrProviders = Array()
        ArrAdvisers = Array()

        GetWorkbook StrAdviserReportFilename, StrAdviserReportFilePath
        Set WbAdviserReport = Workbooks(StrAdviserReportFilename)
        
        GetWorkbook StrSubsheetFilename, StrSubsheetFilePath
        Set WbSubsheet = Workbooks(StrSubsheetFilename)
    
        AssignWorksheets
    
        InitialiseCollections
            
End Sub

AssignWorksheets InitialiseCollections

Public Sub AssignWorksheets()

    '/======================================================================================================================================================
    '/  Date:           21.08.2015
    '/======================================================================================================================================================
        
        WbAdviserReport.Activate
        
            Set WsAggregatedData = WbAdviserReport.Worksheets("Aggregated Subsheet Data")
            Set WsAdviserReport = WbAdviserReport.Worksheets("Adviser Submissions Report")
            Set WsProviderReport = WbAdviserReport.Worksheets("Provider Submissions Report")
            Set WsProductReport = WbAdviserReport.Worksheets("Product Submissions Report")
            Set WsChangedData = WbAdviserReport.Worksheets("Changed Data")
        
        WbSubsheet.Activate
        
            Set WsNewClient = WbSubsheet.Worksheets("New Client Investment")
            Set WsExistingClient = WbSubsheet.Worksheets("Existing Client Investment")
            Set WsGroupSchemes = WbSubsheet.Worksheets("Group Schemes")
            Set WsOther = WbSubsheet.Worksheets("Other")
            Set WsMcOngoing = WbSubsheet.Worksheets("MC Ongoing")
            Set WsJhOngoing = WbSubsheet.Worksheets("JH Ongoing")
            Set WsAegonQuilterArc = WbSubsheet.Worksheets("AG-QU-ARC")
            Set WsAscentric = WbSubsheet.Worksheets("Ascentric")

End Sub

Public Sub InitialiseCollections()

    '/======================================================================================================================================================
    '/  Date:           21.08.2015
    '/======================================================================================================================================================
    Dim i As Long
    '/======================================================================================================================================================
            
        Set ColAllHeadings = New Collection
            '/ N.B. this will be the order of headings in the aggregated sheet
            
            ColAllHeadings.Add "Adviser"
            
            ColAllHeadings.Add "First Name"
            ColAllHeadings.Add "Last Name"
            ColAllHeadings.Add "Account Name"
            ColAllHeadings.Add "Life Co"
            ColAllHeadings.Add "Date Submitted"
            ColAllHeadings.Add "Description"
            
            ColAllHeadings.Add "Investment Amount"
            ColAllHeadings.Add "Money Received"
            
            ColAllHeadings.Add "Total Monthly Premium"
            ColAllHeadings.Add "Single Premium"
            
            ColAllHeadings.Add "Commission Due"
            ColAllHeadings.Add "Comm Paid - Checked To Bank"
            ColAllHeadings.Add "Date Received - Bank"
            
            For i = 1 To 12
                ColAllHeadings.Add DateValue("01/" & Right("0" & i, 2) & "/2015")
            Next i
        
        
        Set ColMetrics = New Collection
            ColMetrics.Add "Investment Amount"
            ColMetrics.Add "Single Premium"
            ColMetrics.Add "Total Monthly Premium"
            ColMetrics.Add "Commission Due"
            ColMetrics.Add "Comm Paid - Checked To Bank"
            ColMetrics.Add "Recurring"
            
            
        Set colAdviserNames = New Collection
            colAdviserNames.Add "Martin Cotter", "Martin"
            colAdviserNames.Add "Jon Hussey", "Jon"
            colAdviserNames.Add "Micky Mahbubani", "Micky"
            colAdviserNames.Add "Jeremy Smith", "Jeremy"
            colAdviserNames.Add "Sarah Cotter", "Sarah"
            colAdviserNames.Add "John Cusins", "John"
    
End Sub

GetAllSheetDataIntoArrays

Private Sub GetAllSheetDataIntoArrays()

    '/======================================================================================================================================================
    '/  Author:  Zak Armstrong
    '/  Email:   [email protected]
    '/  Date:    28/August/2015
    '/
    '/  Description:    Creates Arrays for each sheet, Calls sub to fill each with their sheet's data, collects arrays together in arrAggregatedArrys
    '/======================================================================================================================================================
    Dim arrNewClient                        As Variant
        arrNewClient = Array()
        
    Dim arrExistingClient                   As Variant
        arrExistingClient = Array()
        
    Dim arrGroupSchemes                     As Variant
        arrGroupSchemes = Array()
        
    Dim arrOther                            As Variant
        arrOther = Array()
        
    Dim arrMcOngoing                        As Variant
        arrMcOngoing = Array()
        
    Dim arrJhOngoing                        As Variant
        arrJhOngoing = Array()
        
    Dim arrAegonQuilterArc                  As Variant
        arrAegonQuilterArc = Array()
        
    Dim arrAscentric                        As Variant
        arrAscentric = Array()
    '/======================================================================================================================================================
    
        Dim strTopLeftCellIdentifier    As String
            strTopLeftCellIdentifier = "Adviser"
            
            PutSheetDataInArray WbSubsheet, WsNewClient, arrNewClient, strTopLeftCellIdentifier
            PutSheetDataInArray WbSubsheet, WsExistingClient, arrExistingClient, strTopLeftCellIdentifier
            PutSheetDataInArray WbSubsheet, WsGroupSchemes, arrGroupSchemes, strTopLeftCellIdentifier
            PutSheetDataInArray WbSubsheet, WsOther, arrOther, strTopLeftCellIdentifier
            PutSheetDataInArray WbSubsheet, WsMcOngoing, arrMcOngoing, strTopLeftCellIdentifier
            PutSheetDataInArray WbSubsheet, WsJhOngoing, arrJhOngoing, strTopLeftCellIdentifier
            PutSheetDataInArray WbSubsheet, WsAegonQuilterArc, arrAegonQuilterArc, strTopLeftCellIdentifier
    
        strTopLeftCellIdentifier = "Account No"
            PutSheetDataInArray WbSubsheet, WsAscentric, arrAscentric, strTopLeftCellIdentifier
    
            InsertAscentricLifeCoColumn arrAscentric
                
        ReDim ArrAggregatedArrays(1 To 8)
            ArrAggregatedArrays(1) = arrNewClient
            ArrAggregatedArrays(2) = arrExistingClient
            ArrAggregatedArrays(3) = arrGroupSchemes
            ArrAggregatedArrays(4) = arrOther
            ArrAggregatedArrays(5) = arrMcOngoing
            ArrAggregatedArrays(6) = arrJhOngoing
            ArrAggregatedArrays(7) = arrAegonQuilterArc
            ArrAggregatedArrays(8) = arrAscentric
        
End Sub

InsertAscentricLifeCoColumn

Public Sub InsertAscentricLifeCoColumn(ByRef arrAscentric As Variant)

    '/======================================================================================================================================================
    '/  Author:  Zak Armstrong
    '/  Email:   [email protected]
    '/  Date:    17/August/2015
    '/
    '/  Description:    Inserts a column in the ascentric data array called "Life Co" and filled with "Ascentric" for easy identification later
    '/======================================================================================================================================================
    Dim i As Long
    Dim j As Long
    Dim k As Long
    
    Dim LB1 As Long, UB1 As Long
    Dim LB2 As Long, UB2 As Long
    '/======================================================================================================================================================
    
    AssignArrayBounds arrAscentric, LB1, UB1, LB2, UB2

    ReDim Preserve arrAscentric(LB1 To UB1, LB2 To UB2 + 1)
        
        arrAscentric(LB1 + 1, UB2 + 1) = "Life Co"
        
            For i = LB1 + 2 To UB1
                arrAscentric(i, UB2 + 1) = "Ascentric"
            Next i
    
End Sub

FilterSheetArrays

Private Sub FilterSheetArrays()

    Dim i As Long
    Dim LB1 As Long, UB1 As Long
    
        AssignArrayBounds ArrAggregatedArrays, LB1, UB1
    
        For i = LB1 To UB1
            FilterSheetArrayForColumns ArrAggregatedArrays(i)
        Next i
        
End Sub

FilterSheetArraysForColumns

Private Sub FilterSheetArrayForColumns(ByRef arrSource As Variant)

    '/======================================================================================================================================================
    '/  Author:  Zak Armstrong
    '/  Email:   [email protected]
    '/  Date:    12/August/2015
    '/
    '/  Description:    Takes Sheet arrays, finds the columns from the colAllHeadings, recreates the array with just that data (and empty columns for the ones not found)
    '/======================================================================================================================================================
    Dim i As Long, j As Long, k As Long
    
    Dim LB1 As Long, UB1 As Long
    Dim LB2 As Long, UB2 As Long
    
    Dim arrTempArray        As Variant
        arrTempArray = Array()
        
    Dim arrHeadingsRow      As Variant
        arrHeadingsRow = Array()
    '/======================================================================================================================================================
        
        AssignArrayBounds arrSource, LB1, UB1, LB2, UB2
        
        arrHeadingsRow = RowFrom2dArray(arrSource, 1)
        
        arrHeadingsRow = ElementsToStrings1dArray(arrHeadingsRow)
        
    ReDim arrTempArray(0 To UB1, 0 To ColAllHeadings.Count)
        arrTempArray(0, 0) = arrSource(0, 0)
    
    
    Dim lngDestinationColumn    As Long
    Dim lngSourceColumn         As Long
    
    Dim varColumnPosition   As Variant
    
    Dim strHeading  As String

        For i = 1 To ColAllHeadings.Count
            strHeading = ColAllHeadings(i)
            varColumnPosition = IndexInArray1d(arrHeadingsRow, strHeading)
            
                If IsError(varColumnPosition) _
                    Then
                        MissingDataHeadingsHandler arrSource, strHeading
                    Else
                        lngDestinationColumn = i
                        lngSourceColumn = varColumnPosition
                    
                        CopyArrayColumn2d arrSource, lngSourceColumn, arrTempArray, lngDestinationColumn
                End If
        Next i
            
        arrSource = arrTempArray
    
End Sub

MissingDataHeadingsHandler

Public Sub MissingDataHeadingsHandler(ByRef arrCurrentArray As Variant, ByVal strHeading As String)

    '/======================================================================================================================================================
    '/  Author:  Zak Armstrong
    '/  Email:   [email protected]
    '/  Date:    13/August/2015
    '/
    '/  Description:    Handle instances where a column heading can't be found. Reference against sheet-specific lists to see if the column should be there or not.
    '/======================================================================================================================================================
    Dim bErrorFound                 As Boolean
    
    Dim colMissingSheetHeadings     As Collection   '/  For each sheet, contains the headings that shouldn't be there
    
    Dim strException                As String       '/  holds string items from colMissingSheetHeadings
    Dim strErrorMessage             As String
        
    Dim i                           As Long
    Dim j                           As Long
    Dim k                           As Long
    '/======================================================================================================================================================
    
        strErrorMessage = "Couldn't find Column Heading: " & arrCurrentArray(0, 0) & ": " & strHeading
        bErrorFound = True
        
        Set colMissingSheetHeadings = New Collection
        
            Select Case arrCurrentArray(0, 0) '/ Contains the name of the worksheet the data was taken from
                
                Case Is = WsNewClient.Name
                    InitialiseNewClientHeadingsExceptions colMissingSheetHeadings
                
                Case Is = WsExistingClient.Name
                    InitialiseExistingClientHeadingsExceptions colMissingSheetHeadings
                
        
                Case Is = WsGroupSchemes.Name
                    InitialiseGroupSchemesHeadingsExceptions colMissingSheetHeadings
                
                
                Case Is = WsOther.Name
                    InitialiseOtherHeadingsExceptions colMissingSheetHeadings
            
                
                Case Is = WsMcOngoing.Name
                    InitialiseMcOngoingHeadingsExceptions colMissingSheetHeadings
                
                
                Case Is = WsJhOngoing.Name
                    InitialiseJhOngoingHeadingsExceptions colMissingSheetHeadings
                
                
                Case Is = WsAegonQuilterArc.Name
                    InitialiseAegonQuilterArcHeadingsExceptions colMissingSheetHeadings
            
                
                Case Is = WsAscentric.Name
                    InitialiseAscentricHeadingsExceptions colMissingSheetHeadings
                    
                Case Else
                    ErrorMessage strErrorMessage
                    
            End Select
            
            
                For i = 1 To colMissingSheetHeadings.Count
                    strException = colMissingSheetHeadings(i)
                    If strHeading = strException Then bErrorFound = False
                Next i
        
                If bErrorFound = True Then ErrorMessage (strErrorMessage)

End Sub

Initialise<Worksheet>HeadingsExceptions First one shown for illustration

Public Sub InitialiseNewClientHeadingsExceptions(ByRef colMissingSheetHeadings As Collection)

    Dim i As Long

            colMissingSheetHeadings.Add ("Total Monthly Premium")
            colMissingSheetHeadings.Add ("Single Premium")
            colMissingSheetHeadings.Add ("Account Name")
            colMissingSheetHeadings.Add ("Life Co")
        For i = 1 To 12
            colMissingSheetHeadings.Add (DateValue("01/" & Right("0" & i, 2) & "/" & Year(Date)))
        Next i

End Sub

AggregateSheetData

Private Sub AggregateSheetData()

    '/======================================================================================================================================================
    '/  Author:  Zak Armstrong
    '/  Email:   [email protected]
    '/  Date:    13/August/2015
    '/
    '/  Description:   For Each array, add the data to arrAggregatedData
    '/======================================================================================================================================================
    Dim i As Long, j As Long, k As Long
    
    Dim rngTopLeftCell  As Range
    
    Dim lngCurrentRow   As Long
    
    Dim LB1 As Long, UB1 As Long
    Dim LB2 As Long, UB2 As Long
    '/======================================================================================================================================================
        ReDim ArrAggregatedData(1 To ColAllHeadings.Count, 1 To 1)
        
            lngCurrentRow = 1
        
            For i = 1 To ColAllHeadings.Count
                ArrAggregatedData(i, 1) = ColAllHeadings(i)
            Next i
               
        '/ All arrays were created as 0 - X, 0 - Y, hence LB + 1 and LB + 2
            For i = LBound(ArrAggregatedArrays) To UBound(ArrAggregatedArrays)
            
                AssignArrayBounds ArrAggregatedArrays(i), LB1, UB1, LB2, UB2
                
                    For j = LB1 + 2 To UB1
                    lngCurrentRow = lngCurrentRow + 1
                    ReDim Preserve ArrAggregatedData(1 To ColAllHeadings.Count, 1 To lngCurrentRow)
                    
                        For k = LB2 + 1 To UB2
                            ArrAggregatedData(k, lngCurrentRow) = ArrAggregatedArrays(i)(j, k)
                        Next k
                    Next j
            Next i

        Transpose2dArray ArrAggregatedData

End Sub

PrintAggregatedData

Private Sub FilterSheetArrays()

    Dim i As Long
    Dim LB1 As Long, UB1 As Long
    
        AssignArrayBounds ArrAggregatedArrays, LB1, UB1
    
        For i = LB1 To UB1
            FilterSheetArrayForColumns ArrAggregatedArrays(i)
        Next i
        
End Sub

CleanUpAggregatedData

Private Sub CleanUpAggregatedData()

    '/======================================================================================================================================================
    '/  Author:  Zak Armstrong
    '/  Email:   [email protected]
    '/  Date:    13/August/2015
    '/
    '/  Description:   Clean up the aggregated data table (converting shortened names to full names, removing in-sheet totals, replacing "N/A" etc.)
    '/                 Makes a record of all changes (with the row for context) in the "Changed Data" sheet.
    '/======================================================================================================================================================
    Dim lngHeaderEndColumn As Long
    
    Dim LB1 As Long, UB1 As Long
    Dim LB2 As Long, UB2 As Long
    
    Dim arrChangedData As Variant
        arrChangedData = Array()
    '/======================================================================================================================================================
    
            CreateHeadingChangedData arrChangedData, lngHeaderEndColumn
    
        AssignRangeBoundsOfData WsAggregatedData.Cells(1, 1), LB1, UB1, LB2, UB2
        
            RemoveUnwantedData arrChangedData, lngHeaderEndColumn, LB1, UB1, LB2, UB2
            
            Transpose2dArray arrChangedData
            
            Print2dArrayToSheet WbAdviserReport, WsChangedData, arrChangedData, WsChangedData.Cells(1, 1)
        
        AssignRangeBoundsOfData WsAggregatedData.Cells(1, 1), LB1, UB1, LB2, UB2
        
            ChangeAdviserNames lngHeaderEndColumn, LB1, UB1, LB2, UB2

End Sub

CreateHeadingChangedData

Public Sub CreateHeadingChangedData(ByRef arrChangedData As Variant, ByRef lngHeaderEndColumn As Long)

Dim i As Long
    
    ReDim arrChangedData(1 To ColAllHeadings.Count + 4, 1 To 1)
    
        arrChangedData(1, 1) = "Trigger Value"
        arrChangedData(2, 1) = "Row"
        arrChangedData(3, 1) = "Action"
        lngHeaderEndColumn = 3 + 1
        
        For i = 1 To ColAllHeadings.Count
            arrChangedData(lngHeaderEndColumn + i, 1) = ColAllHeadings(i)
        Next i

End Sub

CreateHeadingChangedData

Public Sub RemoveUnwantedData(ByRef arrChangedData As Variant, ByRef lngHeaderEndColumn As Long, ByRef LB1 As Long, ByRef UB1 As Long, ByRef LB2 As Long, ByRef UB2 As Long)
    
    Dim rngHolder As Range
    Dim i As Long, j As Long
    
    WbAdviserReport.Activate
    WsAggregatedData.Activate
        
        For i = UB1 To LB1 + 1 Step -1
        
            Set rngHolder = Cells(i, LB2)
            If rngHolder.Text = "Total" Then RemoveRow arrChangedData, lngHeaderEndColumn, rngHolder, LB2, UB2
            
            '/ Numeric Columns: (1) + 5 (Date Submitted) (1) + (7 - 25) (Inv. amount, premiums, commissions, Jan 2015 - Dec 2015)
            Set rngHolder = Cells(i, LB2 + 5)
            If Not (IsNumeric(rngHolder.Value) Or IsDate(rngHolder.Value)) Then RemoveCellContents arrChangedData, lngHeaderEndColumn, rngHolder, LB2, UB2
            
            For j = 7 To 25
                Set rngHolder = Cells(i, LB2 + j)
                If Not (IsNumeric(rngHolder.Value) Or IsDate(rngHolder.Value)) Then RemoveCellContents arrChangedData, lngHeaderEndColumn, rngHolder, LB2, UB2
            Next j
            
        Next i
        
End Sub

RemoveCellContents RemoveRow

Public Sub RemoveCellContents(ByRef arrChangedData As Variant, ByVal lngHeaderEndColumn As Long, ByRef rngTargetCell As Range, ByVal lngFirstColumn As Long, ByVal lngFinalColumn As Long)

    Dim lngCurrentRow As Long
    Dim lngFinalRow   As Long
    
    Dim lngRowLength As Long
        lngRowLength = lngFinalColumn - lngFirstColumn + 1
    
    Dim rngTargetRow As Range
    
    Dim i As Long
    
    Dim arrTemp() As Variant
    ReDim arrTemp(1 To lngRowLength) As Variant
    
        lngCurrentRow = rngTargetCell.Row
        For i = lngFirstColumn To lngFinalColumn
            arrTemp(i) = WsAggregatedData.Cells(lngCurrentRow, i).Value
        Next i
    
    Dim LB1 As Long, UB1 As Long
    Dim LB2 As Long, UB2 As Long
    
        AssignArrayBounds arrChangedData, LB1, UB1, LB2, UB2
    ReDim Preserve arrChangedData(LB1 To UB1, LB2 To UB2 + 1)
    
        For i = 1 To lngRowLength
            arrChangedData(lngHeaderEndColumn + i, UB2 + 1) = arrTemp(i)
        Next i
        
        arrChangedData(1, UB2 + 1) = rngTargetCell.Value
        arrChangedData(2, UB2 + 1) = "Row: " & rngTargetCell.Row
        arrChangedData(3, UB2 + 1) = "Cleared Contents"
        
        rngTargetCell.ClearContents

End Sub

Public Sub RemoveRow(ByRef arrChangedData As Variant, ByVal lngHeaderEndColumn As Long, ByRef rngTargetCell As Range, ByVal lngFirstColumn As Long, ByVal lngFinalColumn As Long)

    Dim lngCurrentRow As Long
    Dim lngFinalRow   As Long
    
    Dim lngRowLength As Long
        lngRowLength = lngFinalColumn - lngFirstColumn + 1
    
    Dim rngTargetRow As Range
    
    Dim i As Long
    
    Dim arrTemp() As Variant
    ReDim arrTemp(1 To lngRowLength) As Variant
    
        lngCurrentRow = rngTargetCell.Row
        For i = lngFirstColumn To lngFinalColumn
            arrTemp(i) = WsAggregatedData.Cells(lngCurrentRow, i).Value
        Next i
    
    Dim LB1 As Long, UB1 As Long
    Dim LB2 As Long, UB2 As Long
    
        AssignArrayBounds arrChangedData, LB1, UB1, LB2, UB2
    ReDim Preserve arrChangedData(LB1 To UB1, LB2 To UB2 + 1)
    
        For i = 1 To lngRowLength
            arrChangedData(lngHeaderEndColumn + i, UB2 + 1) = arrTemp(i)
        Next i
        
        arrChangedData(1, UB2 + 1) = rngTargetCell.Value
        arrChangedData(2, UB2 + 1) = "Row: " & rngTargetCell.Row
        arrChangedData(3, UB2 + 1) = "Deleted Row"
        
        Rows(lngCurrentRow).Delete

End Sub

ChangeAdviserNames

Public Sub ChangeAdviserNames(ByRef lngHeaderEndColumn As Long, ByRef LB1 As Long, ByRef UB1 As Long, ByRef LB2 As Long, ByRef UB2 As Long)

    WbAdviserReport.Activate
    WsAggregatedData.Activate
    
    Dim rngHolder As Range
    
    Dim i As Long, j As Long
    
    Dim bError As Boolean
    
    Dim strErrorMessage As String
    
        For i = UB1 To LB1 + 1 Step -1
        
        Set rngHolder = Cells(i, LB2)
        
            Select Case rngHolder.Text
            
                Case Is = "Jon"
                    rngHolder.Value = colAdviserNames.Item(rngHolder.Text)
                
                Case Is = "Martin"
                    rngHolder.Value = colAdviserNames.Item(rngHolder.Text)
                
                Case Is = "Micky"
                    rngHolder.Value = colAdviserNames.Item(rngHolder.Text)
                
                Case Is = "Jeremy"
                    rngHolder.Value = colAdviserNames.Item(rngHolder.Text)
                
                Case Is = "John"
                    rngHolder.Value = colAdviserNames.Item(rngHolder.Text)
                
                Case Is = "Sarah"
                    rngHolder.Value = colAdviserNames.Item(rngHolder.Text)
            
                Case Else
                    bError = True
                
                    For j = 1 To colAdviserNames.Count
                        If rngHolder.Text = colAdviserNames(j) Then bError = False
                    Next j
                    
                    If bError _
                        Then
                            strErrorMessage = "Unidentified Adviser - Row: " & i & "Text: " & rngHolder.Text
                            ErrorMessage (strErrorMessage)
                    End If
                
            End Select
        
        Next i

End Sub

Module 0: M0_Standard_Methods.

N.B. if you have any advice relating purely to the standard methods (and not, for instance, how they're used in the main project), I have a separate question for that

Option Explicit
Option Compare Text

Public Sub GetWorkbook(ByVal strFilename As String, ByVal strFilePath As String)

    Dim bWbIsOpen As Boolean
    
    bWbIsOpen = WorkbookIsOpen(strFilename)
    If Not bWbIsOpen Then Workbooks.Open strFilePath & strFilename

End Sub

Public Function WorkbookIsOpen(ByVal strTargetName As String) As Boolean

    Dim wbTest As Workbook

        On Error Resume Next

            Set wbTest = Workbooks(strTargetName)

            WorkbookIsOpen = (wbTest.Name = strTargetName)

        On Error GoTo 0

End Function

Public Sub PutSheetDataInArray(ByRef wbCurrent As Workbook, ByRef wsCurrent As Worksheet, ByRef arrCurrentArray As Variant, Optional ByVal strTopLeftCellIdentifier As Variant, _
Optional ByVal lngStartRow As Long = 1, Optional ByVal lngEndRow As Variant, _
Optional ByVal lngStartColumn As Long = 1, Optional ByVal lngEndColumn As Variant)
    '/======================================================================================================================================================
    Dim i As Long, j As Long, k As Long
    
    Dim rngTopLeftCell  As Range
    Dim rngSearchRange  As Range
    
    Dim strErrorMessage As String
    
    Dim arrHiddenColumns    As Variant
        arrHiddenColumns = Array()
        
    Dim arrHiddenRows       As Variant
        arrHiddenRows = Array()
        
    Dim LB1 As Long, UB1 As Long
    Dim LB2 As Long, UB2 As Long
    '/======================================================================================================================================================
        wbCurrent.Activate
        wsCurrent.Activate
            
        If IsMissing(strTopLeftCellIdentifier) _
            Then
                Set rngTopLeftCell = Cells(1, 1)
            ElseIf TypeName(strTopLeftCellIdentifier) = "String" _
                Then
                    If IsMissing(lngEndRow) Then lngEndRow = wsCurrent.Rows.Count
                    If IsMissing(lngEndColumn) Then lngEndColumn = wsCurrent.Columns.Count
                        
                    Set rngSearchRange = wsCurrent.Range(Cells(lngStartRow, lngStartColumn), Cells(lngEndRow, lngEndColumn))
                    Set rngTopLeftCell = CellContainingStringInRange(rngSearchRange, strTopLeftCellIdentifier)
                Else
                    strErrorMessage = "strTopLeftCellIdentifier must be a string, not a " & TypeName(strTopLeftCellIdentifier)
                    ErrorMessage (strErrorMessage)
        End If
            
            
        LB1 = rngTopLeftCell.Row
        LB2 = rngTopLeftCell.Column
        AssignRangeBoundsOfData rngTopLeftCell, UB1:=UB1, UB2:=UB2
        
        RecordHiddenRowsAndUnhide arrHiddenRows, LB1, UB1
        RecordHiddenColumnsAndUnhide arrHiddenColumns, LB2, UB2
    
            WriteRangeToArrayIteratively wsCurrent, arrCurrentArray, LB1, UB1, LB2, UB2
    
        HideRows arrHiddenRows
        HideColumns arrHiddenColumns
    
End Sub

Public Function CellContainingStringInRange(ByRef rngSearch As Range, ByVal strSearch As String) As Range

    Dim strErrorMessage As String
    
        Set CellContainingStringInRange = rngSearch.Find(strSearch, LookIn:=xlValues)
    
        If CellContainingStringInRange Is Nothing _
            Then
                strErrorMessage = "Couldn't find cell """ & strSearch & """ in " & rngSearch.Worksheet.Name
                ErrorMessage (strErrorMessage)
        End If
    
End Function

Public Sub RecordHiddenRowsAndUnhide(ByRef arrHiddenRows As Variant, ByVal LB1 As Long, ByVal UB1 As Long)
    
    Dim i As Long
    
    Dim lngCounter As Long
    
        For i = LB1 To UB1
            If Rows(i).EntireRow.Hidden _
                Then
                    lngCounter = lngCounter + 1
                    ReDim Preserve arrHiddenRows(1 To lngCounter)
                    arrHiddenRows(lngCounter) = i
                    Rows(i).Hidden = False
            End If
        Next i
        
End Sub

Public Sub RecordHiddenColumnsAndUnhide(ByRef arrHiddenColumns As Variant, ByVal LB2 As Long, ByVal UB2 As Long)
    
    Dim i As Long
    
    Dim lngCounter As Long
    
        For i = LB2 To UB2
            If Columns(i).EntireRow.Hidden _
                Then
                    lngCounter = lngCounter + 1
                    ReDim Preserve arrHiddenColumns(1 To lngCounter)
                    arrHiddenColumns(lngCounter) = i
                    Columns(i).Hidden = False
            End If
        Next i
        
End Sub

Public Sub HideRows(ByRef arrHiddenRows As Variant)
    Dim i As Long
    
        For i = LBound(arrHiddenRows) To UBound(arrHiddenRows)
            Rows(i).EntireRow.Hidden = True
        Next i
        
End Sub

Public Sub HideColumns(ByRef arrHiddenColumns As Variant)
    Dim i As Long
    
        For i = LBound(arrHiddenColumns) To UBound(arrHiddenColumns)
            Columns(i).EntireRow.Hidden = True
        Next i
        
End Sub

Public Sub AssignRangeBoundsOfData(ByRef rngCell As Range, Optional ByRef LB1 As Variant, Optional ByRef UB1 As Variant, Optional ByRef LB2 As Variant, Optional ByRef UB2 As Variant)

    Dim wbCurrent As Workbook
    Dim wsCurrent As Worksheet
    
        AssignCurrentBookAndSheet wbCurrent, wsCurrent
    
    Dim wsRngCell As Worksheet
    Dim wbRngCell As Workbook
    
        AssignRangeBookAndSheet rngCell, wbRngCell, wsRngCell
    
        wbRngCell.Activate
        wsRngCell.Activate
    
    Dim rngCurrentRegion As Range
    Set rngCurrentRegion = rngCell.CurrentRegion
    
        If Not IsMissing(LB1) Then LB1 = rngCurrentRegion.Row
        If Not IsMissing(LB2) Then LB2 = rngCurrentRegion.Column
        
        If Not IsMissing(UB1) Then UB1 = rngCurrentRegion.Row + rngCurrentRegion.Rows.Count - 1
        If Not IsMissing(UB2) Then UB2 = rngCurrentRegion.Column + rngCurrentRegion.Columns.Count - 1
        
        wbCurrent.Activate
        wsCurrent.Activate

End Sub

Public Sub CopyArrayContents5d(ByRef arrSource As Variant, ByRef arrDestination As Variant)

    Dim LB1 As Long, UB1 As Long
    Dim LB2 As Long, UB2 As Long
    Dim LB3 As Long, UB3 As Long
    Dim LB4 As Long, UB4 As Long
    Dim LB5 As Long, UB5 As Long
    
    Dim i As Long, j As Long, k As Long
    Dim l As Long, m As Long
    
        AssignArrayBounds arrSource, LB1, UB1, LB2, UB2, LB3, UB3, LB4, UB4, LB5, UB5
    
        Erase arrDestination
        ReDim arrDestination(LB1 To UB1, LB2 To UB2, LB3 To UB3, LB4 To UB4, LB5 To UB5)
                                
        For i = LB1 To UB1
        For j = LB2 To UB2
        For k = LB3 To UB3
        For l = LB4 To UB4
        For m = LB5 To UB5
            arrDestination(i, j, k, l, m) = arrSource(i, j, k, l, m)
        Next m
        Next l
        Next k
        Next j
        Next i

End Sub

Public Sub CopyArrayContents4d(ByRef arrSource As Variant, ByRef arrDestination As Variant)

    Dim LB1 As Long, UB1 As Long
    Dim LB2 As Long, UB2 As Long
    Dim LB3 As Long, UB3 As Long
    Dim LB4 As Long, UB4 As Long
    
    Dim i As Long, j As Long, k As Long
    Dim l As Long
    
        AssignArrayBounds arrSource, LB1, UB1, LB2, UB2, LB3, UB3, LB4, UB4
    
        Erase arrDestination
        ReDim arrDestination(LB1 To UB1, LB2 To UB2, LB3 To UB3, LB4 To UB4)
                                
        For i = LB1 To UB1
        For j = LB2 To UB2
        For k = LB3 To UB3
        For l = LB4 To UB4
            arrDestination(i, j, k, l) = arrSource(i, j, k, l)
        Next l
        Next k
        Next j
        Next i

End Sub

Public Sub CopyArrayContents3d(ByRef arrSource As Variant, ByRef arrDestination As Variant)

    Dim LB1 As Long, UB1 As Long
    Dim LB2 As Long, UB2 As Long
    Dim LB3 As Long, UB3 As Long
    
    Dim i As Long, j As Long, k As Long
    
        AssignArrayBounds arrSource, LB1, UB1, LB2, UB2, LB3, UB3
    
        Erase arrDestination
        ReDim arrDestination(LB1 To UB1, LB2 To UB2, LB3 To UB3)
                                
        For i = LB1 To UB1
        For j = LB2 To UB2
        For k = LB3 To UB3
            arrDestination(i, j, k) = arrSource(i, j, k)
        Next k
        Next j
        Next i

End Sub

Public Sub CopyArrayContents2d(ByRef arrSource As Variant, ByRef arrDestination As Variant)

    Dim LB1 As Long, UB1 As Long
    Dim LB2 As Long, UB2 As Long
    
    Dim i As Long, j As Long
    
        AssignArrayBounds arrSource, LB1, UB1, LB2, UB2
    
        Erase arrDestination
        ReDim arrDestination(LB1 To UB1, LB2 To UB2)
                                
        For i = LB1 To UB1
        For j = LB2 To UB2
            arrDestination(i, j) = arrSource(i, j)
        Next j
        Next i

End Sub

Public Sub CopyArrayContents1d(ByRef arrSource As Variant, ByRef arrDestination As Variant)

    Dim LB1 As Long, UB1 As Long
    
    Dim i As Long
    
        AssignArrayBounds arrSource, LB1, UB1
    
        Erase arrDestination
        ReDim arrDestination(LB1 To UB1)
                                
        For i = LB1 To UB1
            arrDestination(i) = arrSource(i)
        Next i
        
End Sub

Public Sub AssignArrayBounds(ByRef arrCurrentArray As Variant, _
                                Optional ByRef LB1 As Variant, Optional ByRef UB1 As Variant, _
                                Optional ByRef LB2 As Variant, Optional ByRef UB2 As Variant, _
                                Optional ByRef LB3 As Variant, Optional ByRef UB3 As Variant, _
                                Optional ByRef LB4 As Variant, Optional ByRef UB4 As Variant, _
                                Optional ByRef LB5 As Variant, Optional ByRef UB5 As Variant)
                                
    If Not IsMissing(LB1) Then LB1 = LBound(arrCurrentArray, 1)
    If Not IsMissing(UB1) Then UB1 = UBound(arrCurrentArray, 1)
    If Not IsMissing(LB2) Then LB2 = LBound(arrCurrentArray, 2)
    If Not IsMissing(UB2) Then UB2 = UBound(arrCurrentArray, 2)
    If Not IsMissing(LB3) Then LB3 = LBound(arrCurrentArray, 3)
    If Not IsMissing(UB3) Then UB3 = UBound(arrCurrentArray, 3)
    If Not IsMissing(LB4) Then LB4 = LBound(arrCurrentArray, 4)
    If Not IsMissing(UB4) Then UB4 = UBound(arrCurrentArray, 4)
    If Not IsMissing(LB5) Then LB5 = LBound(arrCurrentArray, 5)
    If Not IsMissing(UB5) Then UB5 = UBound(arrCurrentArray, 5)

End Sub

Public Sub Transpose2dArray(ByRef arrCurrentArray As Variant)

    Dim LB1 As Long, UB1 As Long
    Dim LB2 As Long, UB2 As Long
    
    Dim i As Long, j As Long
    
        AssignArrayBounds arrCurrentArray, LB1, UB1, LB2, UB2
        
    Dim arrTransposedArray() As Variant
    ReDim arrTransposedArray(LB2 To UB2, LB1 To UB1)
        
        For i = LB1 To UB1
        For j = LB2 To UB2
            arrTransposedArray(j, i) = arrCurrentArray(i, j)
        Next j
        Next i
        
    Erase arrCurrentArray
    ReDim arrCurrentArray(LB2 To UB2, LB1 To UB1)
        
        arrCurrentArray = arrTransposedArray
        
End Sub

Public Sub Print2dArrayToSheet(ByRef wbTarget As Workbook, ByRef wsTarget As Worksheet, ByRef arrData As Variant, ByRef rngStartCell As Range)

    Dim LB1 As Long, UB1 As Long
    Dim LB2 As Long, UB2 As Long
    
    Dim rngTableRange As Range
    
        wbTarget.Activate
        wsTarget.Activate
    
        AssignArrayBounds arrData, LB1, UB1, LB2, UB2
    Set rngTableRange = Range(rngStartCell, Cells(rngStartCell.Row + UB1 - LB1, rngStartCell.Column + UB2 - LB2))
        rngTableRange = arrData

End Sub

Public Sub CopyArrayColumn2d(ByRef arrSource As Variant, ByVal lngSourceColumn As Long, ByRef arrTarget As Variant, ByVal lngTargetColumn As Long)

    Dim i As Long, j As Long, k As Long
    
    Dim LB1 As Long, UB1 As Long
    
        AssignArrayBounds arrSource, LB1, UB1
        
        For i = LB1 To UB1
            arrTarget(i, lngTargetColumn) = arrSource(i, lngSourceColumn)
        Next i
    
End Sub

Public Function RowFrom2dArray(ByRef arrSource As Variant, ByVal lngRow As Long) As Variant

    Dim LB2 As Long, UB2 As Long
    Dim i As Long
    
    Dim arrRow As Variant
        arrRow = Array()
    
        AssignArrayBounds arrSource, LB2:=LB2, UB2:=UB2
        
        ReDim arrRow(LB2 To UB2)
        
        For i = LB2 To UB2
            arrRow(i) = arrSource(lngRow, i)
        Next i
        
        RowFrom2dArray = arrRow
        
End Function

Public Function IndexInArray1d(ByRef arrSource As Variant, ByVal varSearch As Variant) As Variant

    Dim LB1 As Long, UB1 As Long
    
    Dim bMatchFound As Boolean
    
    Dim i As Long
    
        AssignArrayBounds arrSource, LB1, UB1
        bMatchFound = False
        
        i = LB1
        Do While i <= UB1 And bMatchFound = False
            If arrSource(i) = varSearch _
                Then
                    bMatchFound = True
                    IndexInArray1d = i
            End If
            i = i + 1
        Loop
        
        If Not bMatchFound Then IndexInArray1d = CVErr(xlErrValue)
    
End Function

Public Sub AssignCurrentBookAndSheet(ByRef wbCurrent As Workbook, ByRef wsCurrent As Worksheet)

    Set wbCurrent = ThisWorkbook
    Set wsCurrent = ActiveSheet
    
End Sub

Public Sub AssignRangeBookAndSheet(ByRef rngTarget As Range, ByRef wbTarget As Workbook, ByRef wsTarget As Worksheet)

    Set wbTarget = rngTarget.Worksheet.Parent
    Set wsTarget = rngTarget.Worksheet
    
End Sub

Public Sub WriteRangeToArrayIteratively(ByRef wsCurrent As Worksheet, arrCurrentArray As Variant, ByVal LB1 As Long, ByVal UB1 As Long, ByVal LB2 As Long, ByVal UB2 As Long)
    Dim i As Long, j As Long
    
    wsCurrent.Activate
    
    ReDim arrCurrentArray(0 To UB1 - LB1 + 1, 0 To UB2 - LB2 + 1)
        arrCurrentArray(0, 0) = wsCurrent.Name
        
        For i = LB1 To UB1
            For j = LB2 To UB2
                arrCurrentArray(i - LB1 + 1, j - LB2 + 1) = wsCurrent.Cells(i, j)
            Next j
        Next i
        
End Sub

Public Function ElementsToStrings1dArray(ByRef arrSource As Variant) As Variant

    Dim i As Long
    Dim arrRow As Variant
        arrRow = arrSource
        
        For i = LBound(arrSource) To UBound(arrSource)
            arrRow(i) = CStr(arrRow(i))
        Next i
        
        ElementsToStrings1dArray = arrRow
        
End Function

Public Sub ErrorMessage(ByVal strErrorMessage As String)

    MsgBox strErrorMessage
    Debug.Print strErrorMessage
    RestoreApplicationSettings
    Stop

End Sub

Public Sub StoreApplicationSettings()

    varScreenUpdating = Application.ScreenUpdating
    varEnableEvents = Application.EnableEvents
    varCalculation = Application.Calculation
    
End Sub

Public Sub DisableApplicationSettings()

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
End Sub

Public Sub RestoreApplicationSettings()

    Application.ScreenUpdating = varScreenUpdating
    Application.EnableEvents = varEnableEvents
    Application.Calculation = varCalculation
    
End Sub

Public Sub CloseWorkbook(ByRef wbTarget As Workbook)

    Application.DisplayAlerts = False
        wbTarget.Close
    Application.DisplayAlerts = True

End Sub

Answer 1

Some parts that look a bit questionable:
use of select case to do the same actions

Select Case rngHolder.Text

Case Is = "Jon"
  rngHolder.Value = colAdviserNames.Item(rngHolder.Text)

Case Is = "Martin"
  rngHolder.Value = colAdviserNames.Item(rngHolder.Text)
....

why not simply:

Select Case rngHolder.Text

Case "Jon", "Martin", "Micky", "Jeremy", "John", "Sarah"
  rngHolder.Value = colAdviserNames.Item(rngHolder.Text)
Case Else
  bError = True
  ....

Or do it directly

If IsNumeric(Application.Match(rngHolder.Text, Array("Jon", "Martin", "Micky", "Jeremy", "John", "Sarah"), 0)) Then
  rngHolder.Value = colAdviserNames.Item(rngHolder.Text)
Else
  bError = True
  ....

However, while the last one is faster for bigger arrays to check, it is a bit overpowered for this simple task :)

---

dim lots of variables which act in the same behavior
Mainly used at AssignArrayBounds:

AssignArrayBounds arrSource, LB1, UB1, LB2, UB2, LB3, UB3, LB4, UB4, LB5, UB5

Till now, your code is pretty much clean and easy to read, except for getting the upper and lower bounds, but using it like here it could be simplyfied (at least for my eye) by changing AssignArrayBounds like this:

Public Sub AssignArrayBounds(ArrayToCheck As Variant, LowerBound() As Long, Upperbound() As Long, Optional NumDimensions As Byte = 1)
  Dim i As Byte
  ReDim LowerBound(NumDimensions)
  ReDim Upperbound(NumDimensions)
  For i = 1 To NumDimensions
    LowerBound(i) = LBound(ArrayToCheck, i)
    Upperbound(i) = UBound(ArrayToCheck, i)
  Next
End Sub

For your 5D-array it now would look like this:

Dim LB() as Long
Dim UB() as Long
AssignArrayBounds arrSource, LB, UB, 5

At the other hand you would need to change For k = LB3 To UB3 to For k = LB(3) To UB(3) which is not much more unreadable for my eye. But this may count just for the coding-habit-section ;)

---

loops for creating copy-arrays being the same data-type
However, the last point leads me to something i don't get at all:

Public Sub CopyArrayContents*d(ByRef arrSource As Variant, ByRef arrDestination As Variant)

You call it to ReDim the second array and then looping through all items. But having both as ByRef ... As Variant I don't know why you not simply use:

arrDestination = arrSource

Which would make your second array to a perfect copy on one step (and doing that a LOT faster)... counting 1 and 1 together, there is no reason for this sub at all.
You could not simply use arrDestination{Long} = arrSource{Double} but you sub needs both arrays to be variant, which makes it obsolete (but i may miss something big here again)

---

public variables i just don't get
To start easy Public Const Hyphen As String = " - ". To me it would make sense if it contains something special like tabulator or holds at least more chars than the variable-name has.
Public varScreenUpdating As Boolean and Public varEnableEvents As Boolean are like... umm... honestly, why??? If they need to be turned on/off just do it. I simply don't get the reason for them. As soon as the VBA-execution ends, they will be turned on again, no matter what. There just a few situations (errors) which prevent it to be turned on again, but all of them would also prevent the macro to turn it on again to run. No need to speak it out, but Public varCalculation As XlCalculation is something different so i would not touch it. However: [Re]StoreApplicationSettings now would only contain one line of code which would make the sub obsolete, cus you could run that line directly.

---

every interaction with a real worksheet is MUCH slower than with a variable-array
Looking at WriteRangeToArrayIteratively there may be a bunch of interactions that will slow down the whole execution:

For i = LB1 To UB1
  For j = LB2 To UB2
    arrCurrentArray(i - LB1 + 1, j - LB2 + 1) = wsCurrent.Cells(i, j)
  Next j
Next i

Should be changed to increase greatly the speed while this decreases the legibility. Just using that sniped of code, i would change it to:

Dim tempRange As Variant
tempRange = wsCurrent.Range(Cells(LB1, LB2), Cells(UB1, UB2)).Value
UB1 = UB1 - LB1 + 1
UB2 = UB2 - LB2 + 1
For i = 1 To UB1
  For j = 1 To UB2
    arrCurrentArray(i, j) = tempRange(i, j)
  Next j
Next i

Having the upper left cell of tempRange always being (1, 1) you would need to also use (i - LB1 + 1, j - LB2 + 1) so i changed the UB* to use i and j directly.

---

As a small speed-test: (just skip reading this part if you are aware of that)

Sub comp1()
  Dim a As Variant, b As String, i As Long, j As Long, c As Double
  c = Now
  For i = 1 To 1000000 'cycles
    a = Range("A1:A2").Value
    For j = 1 To 2
      b = a(j, 1)
    Next
  Next
  c = Now - c
  Debug.Print c * 24 * 60 * 60
End Sub

Sub comp2()
  Dim a As Variant, b As String, i As Long, j As Long, c As Double
  c = Now
  For i = 1 To 1000000 'cycles
    For j = 1 To 2
      b = Cells(j, 1).Value
    Next
  Next
  c = Now - c
  Debug.Print c * 24 * 60 * 60
End Sub

This 2 subs will output ~ the same time. The bigger the range gets the more comp1 will speed out comp2. At a range of 3 cells there is already a noticeable difference. Having a range of 100 cells and 10000 cycles comp1 will probably just print a 0 while comp 2 takes some seconds. Also take into account that Cells(1, 1) will be ~66% faster than Range("A1") and normally there will be multiple checks and not only 1 get, so the more you interact with the sheet, the faster you will get by using a variable. Feel free to play a bit with this subs.
Hint: never use something like [A1]... while it may look cool it is just extremely slow...

---

always set variant = Array()

While it is ok for special cases i can't see any reason for doing something like this here. If you use a variant always as an array you simply could directly declare it that way...

Dim MyArray as Variant
    MyArray = Array()
MySub Myarray

Sub MySub(ByRef SpecialArray as Variant)
  Redim SpecialArray(x to y)
...

Simply could be changed to:

Dim MyArray() as Variant
MySub Myarray

Sub MySub(ByRef SpecialArray() as Variant)
  Redim SpecialArray(x to y)
...

There is no need to endlessly set it to an empty array if you never use it in a non-array way.

---

miscellaneous

---

Why use ElementsToStrings1dArray as function? Is somewhere a different use than arrHeadingsRow = ElementsToStrings1dArray(arrHeadingsRow)? That said Transpose2dArray would make sense to being a function having it be set Transpose2dArray = arrTransposedArray at the end. Also having the desired coding Array1 = Array2 at the end, there is no need to ReDim Array1 (it will become a copy and auto ReDimmed to the ranges of Array2.

---

You could change

Public Sub HideColumns(ByRef arrHiddenColumns As Variant)
  Dim i As Long
  For i = LBound(arrHiddenColumns) To UBound(arrHiddenColumns)
      Columns(i).EntireRow.Hidden = True
  Next i
End Sub

to

Public Sub HideColumns(ByRef arrHiddenColumns As Variant)
  Range(Columns(LBound(arrHiddenColumns), Columns(UBound(arrHiddenColumns)).Hidden = True
End Sub

Leads to => one line of code => sub can be skipped (same goes for Hide Rows). At least it will be much faster doing this in one step.

---

Speedup also goes for RecordHiddenRowsAndUnhide/RecordHiddenColumnsAndUnhide:

Public Sub RecordHiddenRowsAndUnhide(ByRef arrHiddenRows As Variant, ByVal LB1 As Long, ByVal UB1 As Long)
  Dim i As Long
  Dim lngCounter As Long
  For i = LB1 To UB1
    If Rows(i).EntireRow.Hidden Then
      lngCounter = lngCounter + 1
      ReDim Preserve arrHiddenRows(1 To lngCounter)
      arrHiddenRows(lngCounter) = i
      Rows(i).Hidden = False
    End If
  Next i
End Sub

can be changed to

Public Sub RecordHiddenRowsAndUnhide(ByRef arrHiddenRows As Variant, ByVal LB1 As Long, ByVal UB1 As Long)
  Dim hRow As Variant, rng As Range, hiddenRows As Long
  Set rng = Range(Rows(LB1), Rows(UB1)) 'get all rows in range
  For Each hRow In rng
    If Not hRow.Hidden Then 'check for each rob to be visible
      hiddenRows = rng.roes.Count - rng.Columns(1).SpecialCells(xlCellTypeVisible).Count 'get the number if hidden rows
      If hiddenrows > 0 Then ReDim Preserve arrHiddenRows(1 To hiddenRows) 'set the array if at least 1 row is hidden
      rng.Hidden = False 'unhide all rows
      Exit Sub 'everything is done get out here :)
    End If
  Next
  ReDim Preserve arrHiddenRows(1 To rng.Rows.Count) 'no visible row found - set to count of rows
  rng.Hidden = False 'unhide all rows
End Sub

While it is more code now, it should also be much faster. Just running for the first visible row and then count all rows in range minus visible rows. It gets a bit confusing for the count of visible rows using the SpecialCells. rng.SpecialCells(xlCellTypeVisible).Rows.Count will just count the rows from the first visible till the next hidden one. So i go with rng.Columns(1) and then count the cells.

---

Assuming you do not open thousands of workbooks at the same time and then check for it endlessly. Try to avoid errors at all cost (they should not be part of coding)

Public Function WorkbookIsOpen(ByVal strTargetName As String) As Boolean
  Dim wbTest As Workbook
  On Error Resume Next
  Set wbTest = Workbooks(strTargetName)
  WorkbookIsOpen = (wbTest.Name = strTargetName)
  On Error GoTo 0
End Function

this can should be changed to:

Public Function WorkbookIsOpen(ByVal strTargetName As String) As Boolean
  Dim wbTest As Workbook
  For Each wbTest In Workbooks
    If wbTest.Name = strTargetName Then
      WorkbookIsOpen = True
      Exit Function
    End If
  Next
End Function

---

To get into the coding-habit-corner again, I would change something like

AssignRangeBoundsOfData rngTopLeftCell, UB1:=UB1, UB2:=UB2

to

AssignRangeBoundsOfData rngTopLeftCell, , UB1, , UB2

Simply cus it is obvious by the variable-names itself.

---

Looking at speed again and avoid doing checks for ranges which are simply not used, consider using UsedRange like

If IsMissing(lngEndRow) Then lngEndRow = wsCurrent.Rows.Count
If IsMissing(lngEndColumn) Then lngEndColumn = wsCurrent.Columns.Count

becomes

If IsMissing(lngEndRow) Then lngEndRow = wsCurrent.UsedRange.Rows.Count
If IsMissing(lngEndColumn) Then lngEndColumn = wsCurrent.UsedRange.Columns.Count

While knowing you are going to use Find for this range (which always just checks inside the UsedRange). Find is still the best way to improve the calculation-time by a big amount

---

You always use For ... Next which is ok for most cases, but then you pop something like this

Public Function IndexInArray1d(ByRef arrSource As Variant, ByVal varSearch As Variant) As Variant
  Dim LB1 As Long, UB1 As Long
  Dim bMatchFound As Boolean
  Dim i As Long
  AssignArrayBounds arrSource, LB1, UB1
  bMatchFound = False
  i = LB1
  Do While i <= UB1 And bMatchFound = False
    If arrSource(i) = varSearch Then
      bMatchFound = True
      IndexInArray1d = i
    End If
    i = i + 1
  Loop
  If Not bMatchFound Then IndexInArray1d = CVErr(xlErrValue)
End Function

Going from a lower value to a higher one is the very best reason to use For ... Next. Is it just for the bMatchFound? Why not do it this way:

Public Function IndexInArray1d(ByRef arrSource As Variant, ByVal varSearch As Variant) As Variant
  Dim LB1 As Long, UB1 As Long
  Dim i As Long
  AssignArrayBounds arrSource, LB1, UB1
  For i = LB1 To UB1
    If arrSource(i) = varSearch Then
      IndexInArray1d = i
      Exit Function
    End If
  Next
  IndexInArray1d = CVErr(xlErrValue)
End Function

If you are sure to not trigger the 255-character-error you also could use Application.Match which also returns an error if nothing was found, but you would need to set it to a variable and later add + LB1 - 1 to get the pos inside the array. (To me it looks like you either tried to do something different or you got bored of it at this point) :D

---

For now that's all i consider as being worth to mention (I will skip the parts already inside the answer of Mat's Mug)

While some of the suggestions are easily done "on the run" others need bigger changes (for less benefit). And i don't know how much speed matters at this point. Also there lots of parts which are not shown here and will not work with my suggestions or may even lead to worsening/slow down. That said, YOU need to understand what's happening at all times (everything else comes later).

Hopefully I was at least able to throw you 1 or 2 ideas for future projects.

Note: Would be happy if someone could check my spelling/formatting and then delete this note. Thanks

Answer 2

I'm aware that making all the declarations line up like this isn't an efficient use of time, but since it's already been done, I'm not about to go and spend more time deliberately undoing it.

Thanks, you just made a feature request for Rubberduck 2.0!

---

You have object references - why do you use Activate?

WbAdviserReport.Activate
WsAggregatedData.Activate

...
Set rngHolder = Cells(i, LB2)

Instead of an implicit reference to the active worksheet (with the Cells call), use an explicit reference, and get rid of the Activate calls:

Set rngHolder = WsAggregatedData.Cells(i, LB2)

---

I like this, but I don't get why you need the line continuation here, nor why you're forcing strErrorMessage to be passed ByVal, since ErrorMessage already states that the strErrorMessage parameter is passed by value:

If bError _
    Then
        strErrorMessage = "Unidentified Adviser - Row: " & i & "Text: " & rngHolder.Text
        ErrorMessage (strErrorMessage)
End If

should be this:

If bError Then
    strErrorMessage = "Unidentified Adviser - Row: " & i & "Text: " & rngHolder.Text
    ErrorMessage strErrorMessage
End If

Why does MissingDataHeadingsHandler spell the condition differently?

If bErrorFound = True Then ErrorMessage (strErrorMessage)

should be:

If bErrorFound Then ErrorMessage strErrorMessage

---

Again, the off-standard indentation is a bit off-putting, and I'm not sure what to think of the vertical whitespace:

Public Function WorkbookIsOpen(ByVal strTargetName As String) As Boolean

    Dim wbTest As Workbook

        On Error Resume Next

            Set wbTest = Workbooks(strTargetName)

            WorkbookIsOpen = (wbTest.Name = strTargetName)

        On Error GoTo 0

End Function

I'd have formatted it like this:

Public Function WorkbookIsOpen(ByVal strTargetName As String) As Boolean

    On Error Resume Next

    Dim wbTest As Workbook
    Set wbTest = Workbooks(strTargetName)

    WorkbookIsOpen = (wbTest.Name = strTargetName)
    On Error GoTo 0

End Function

Notice the variable is declared closer to its usage, and that all executable instructions are at the same level of indentation - but I don't completely disagree with treating On Error Resume Next...On Error GoTo 0 as a code block.