6
\$\begingroup\$

Every piece of business that gets written (E.G. an adviser's client puts an additional £10k payment into a pension plan) goes in a spreadsheet called the SubSheet. It's split into 8 worksheets for different kinds of business, each with lots and lots of columns. E.G. "Adviser" "First Name" "Investment Amount" "Commission Due" "Date Received" "File Check 1 Date" "File Check 1 by:" all that kind of stuff.

N.B. the worksheets do not have identical structures. So aggregation involves standardising all the tables into the same format as well as some other stuff.

Every month a report is put together manually, showing all the company's business, split out by adviser, type of business, provider (E.G. pension provider). This takes a lot of time and is very vulnerable to human error.

The project was to automate the process of creating this report. It works and is 100% accurate (so far as I can determine). It runs to about 2,000 lines across 3 Modules.

What I'm after with this question:

Using this project as an example of my current level of proficiency with best practices, I'm after specific suggestions on how it can be / could have been, structured / written to improve the following criteria:

  • 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. (E.G. I used to do a lot of using exact cell references, so if you added a column, the whole macro broke, in multiple places. Nowadays, I know better.)

  • Reusability: Designing subs/functions/the entire project so they can be easily re-purposed for future projects. (E.G. I rebuilt the sub for getting worksheet data into an array so it could be literally copy-pasted into any future project)

  • Scalability: Things like version control, Splitting subs between Modules, Controlling variable Scope, Adding more control layers, commenting, etc. Basically, if I had to do this project but it was 10 times bigger / more complicated, or involved larger structures than just a workbook, what should I do/change to make it easier to build, easier to debug, easier for me to design / implement, easier to change etc.

Any answer on any aspect of the above would be much appreciated. You can download the workbook /full code here.

Note: This post has most of the actual line-to-line code taken out while preserving the rest of the macro-structure because otherwise it would be WAY over the character limit for posts.

Module 1: "v0_2_M1_Main_Subs"

Option Explicit
Option Compare Text '/ Case Insensitive

Sub Generate_Adviser_Submissions_Report()

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

'/======================================================================================================================================================
'/  Author:  Zak Armstrong
'/  Email:   zak.armstrong@company.co.uk
'/  Date:    12/August/2015
'/  Version: 0.2
'/
'/  Is Called By:   None
'/
'/  Calls:          Open_Workbooks
'/                  Initialise_Worksheets
'/                  Initialise_Collections_And_MetricHeadings
'/                  Initialise_Providers_And_Advisers
'/                  Insert_arrAscentric_LifeCo_Column
'/
'/                  Sheet_Data_To_Array
'/                  Filter_Sheet_Arrays
'/                  Aggregate_Sheet_Data
'/
'/                  Allocate_Business
'/
'/                  Print_Adviser_Report
'/                  Print_Provider_Report
'/
'/  Description:    All Company 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)
'/
'/  Change Log:     | Author            | Date          | Description of Changes
'/                  -----------------------------------------------------------------------------------------------------------------------------------
'/                  |Zak armstrong      | 12.08.2015    | Started v0.2 from scratch. Major difference: now aggregating all subsheet data first and
'/                  |                   |               | only then allocating each piece of business.
'/                  |                   |               |
'/                  |                   | 14.08.2015    | "Finished" Writing Macro. Had succesful test run.
'/                  |                   |               |
'/                  |                   | 17.08.2015    | Reviewed all code, replaced a lot of hard-coded references (e.g. specific position numbers) with
'/                  |                   |               | dynamically generated ones. Re-structured main allocation sub.
'/                  |                   |               |
'/                  |                   | 18.08.2015    | Finished Writing Format_Adviser_Report, Format_Provider_Report, restructured macros from 1 module to 3.
'/                  |                   |               |
'/                  |                   | 19.08.2015    | Double-Checked Code, Slight re-structuring/obfuscation before posting to Code Review (Stack Exchange)
'/                  |                   |               |
'/======================================================================================================================================================
'/ Variable Declaration
'/======================================================================================================================================================
Dim arrNewClient()                      As Variant      '/  An array to hold all data on the "New Client Investment" Sheet
Dim arrExistingClient()                 As Variant      '/  An array to hold all data on the "Existing Client Investment" Sheet
Dim arrGroupSchemes()                   As Variant      '/  An array to hold all data on the "Group Schemes" Sheet
Dim arrOther()                          As Variant      '/  An array to hold all data on the "Other" Sheet
Dim arrMcOngoing()                      As Variant      '/  An array to hold all data on the "MC Ongoing" Sheet
Dim arrJhOngoing()                      As Variant      '/  An array to hold all data on the "JH Ongoing" Sheet
Dim arrAegonQuilterArc()                As Variant      '/  An array to hold all data on the "AG-QU-ARC" Sheet
Dim arrAscentric()                      As Variant      '/  An array to hold all data on the "Ascentric" Sheet

Dim I                                   As Long         '/  General counters
Dim J                                   As Long         '/
Dim K                                   As Long         '/
'/======================================================================================================================================================
'/==================================================
'/ Initialise save Filename
'/==================================================
strCurrentDate = "." & Day(Date) & "." & Month(Date) & "." & Year(Date)
strSavedReportFilename = "Adviser Submissions Report" & strCurrentDate & ".xlsm"

'/==================================================
'/ Check that the workbooks are open
'/==================================================
Call Open_Workbooks

'/==================================================
'/ Initialise Worksheet variables
'/==================================================
Call Initialise_Worksheets

'/==================================================
'/ Initialise Collections
'/==================================================
Call Initialise_Collections_And_MetricHeadings

'/==================================================
'/ Get all sheet data into arrays
'/==================================================
Call Sheet_Data_To_Array(wsNewClient, arrNewClient, "Adviser", 10, 10)
Call Sheet_Data_To_Array(wsExistingClient, arrExistingClient, "Adviser", 10, 10)
Call Sheet_Data_To_Array(wsGroupSchemes, arrGroupSchemes, "Adviser", 10, 10)
Call Sheet_Data_To_Array(wsOther, arrOther, "Adviser", 10, 10)
Call Sheet_Data_To_Array(wsMcOngoing, arrMcOngoing, "Adviser", 10, 10)
Call Sheet_Data_To_Array(wsJhOngoing, arrJhOngoing, "Adviser", 10, 10)
Call Sheet_Data_To_Array(wsAegonQuilterArc, arrAegonQuilterArc, "Adviser", 10, 10)
Call Sheet_Data_To_Array(wsAscentric, arrAscentric, "Account No", 10, 10)

Call Insert_arrAscentric_LifeCo_Column(arrAscentric)

'/==================================================
'/ Filter sheet data for desired columns
'/==================================================
Call Filter_Sheet_Arrays(arrNewClient)
Call Filter_Sheet_Arrays(arrExistingClient)
Call Filter_Sheet_Arrays(arrGroupSchemes)
Call Filter_Sheet_Arrays(arrOther)
Call Filter_Sheet_Arrays(arrMcOngoing)
Call Filter_Sheet_Arrays(arrJhOngoing)
Call Filter_Sheet_Arrays(arrAegonQuilterArc)
Call Filter_Sheet_Arrays(arrAscentric)

'/==================================================
'/ Aggregate Data
'/==================================================
Call Aggregate_Sheet_Data(arrNewClient, arrExistingClient, arrGroupSchemes, arrOther, arrMcOngoing, arrJhOngoing, arrAegonQuilterArc, arrAscentric)

Application.DisplayAlerts = False
wbSubsheet.Close
Application.DisplayAlerts = True

'/==================================================
'/ Populate arrAdvisers and arrProviders
'/==================================================
Call Initialise_Providers_And_Advisers

'/==================================================
'/ Allocate Business to Advisers, Providers, Business Type, Month. Calculate totals
'/==================================================
Call Allocate_Business

'/==================================================
'/ Print Reports
'/==================================================
Call Print_Adviser_Report
Call Print_Provider_Report
'Call Print_Product_Report

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Public Sub Sheet_Data_To_Array(ByRef wsCurrentsheet As Worksheet, ByRef arrCurrentArray() As Variant, ByVal strTopLeftCellIdentifier As String, _
ByVal lngRowsToSearch As Long, ByVal lngColumnsToSearch As Long)

'/======================================================================================================================================================
'/  Author:  Zak Armstrong
'/  Email:   zak.armstrong@company.co.uk
'/  Date:    12/August/2015
'/  Version: 1.0
'/
'/  Is Called By:   Generate_Adviser_Submissions_Report
'/  Calls:          -
'/
'/  Description:    Generic "Get Data from worksheet into Array" subroutine. Slightly altered for this project.
'/  Important Info: Measures range of data based on the last used cells in the TopLeftCell's row and column. Case insensitive search.
'/
'/  Change Log:     | Author            | Date          | Description of Changes
'/                  -----------------------------------------------------------------------------------------------------------------------------------
'/                  |Zak Armstrong      | 12.08.2015    | Wrote Macro
'/                  |                   |               |
'/                  |                   |               |
'/======================================================================================================================================================
'/ Variable Declaration
'/======================================================================================================================================================
Dim I                                           As Long         '/  General counters
Dim J                                           As Long         '/
Dim K                                           As Long         '/

Dim lngFirstrow                                 As Long         '/  First row in the data range
Dim lngFirstColumn                              As Long         '/  first column in the data range
Dim lngFinalRow                                 As Long         '/  Last row in the data range
Dim lngFinalColumn                              As Long         '/  Last Column in the data range

Dim arrTempArray()                              As Variant      '/  Temporarily holds the whole sheet

Dim rngWholeSheet                               As Range        '/  Range to contain all the data

Dim bTopLeftCellFound                           As Boolean      '/  Check to see if cell has been found

Dim lngLastPossibleCellRow                      As Long         '/  The last possible row
Dim lngLastPossibleCellColumn                   As Long         '/  The last possible column
'/======================================================================================================================================================

'/ Find TopLeftCell

'/ Define Range, put into Array

End Sub

Public Sub Filter_Sheet_Arrays(ByRef arrCurrentArray() As Variant)

'/======================================================================================================================================================
'/  Author:  Zak Armstrong
'/  Email:   zak.armstrong@company.co.uk
'/  Date:    12/August/2015
'/
'/  Is Called By:   Generate_Adviser_Submissions_Report
'/  Calls:          Array_Headings_Error_Handler
'/  Description:    Takes Sheet arrays, finds the columns from the colAllHeadings, erases the array and recreates with just that data (and empty columns for the ones not found)
'/
'/  Change Log:     | Author            | Date          | Description of Changes
'/                  -----------------------------------------------------------------------------------------------------------------------------------
'/                  |Zak armstrong      | 12.08.2015    | Wrote Macro
'/                  |                   |               |
'/                  |                   |               |
'/======================================================================================================================================================
'/ Variable Declaration
'/======================================================================================================================================================
Dim I                                           As Long         '/  General counters
Dim J                                           As Long         '/
Dim K                                           As Long         '/

Dim lngFinalRow                                 As Long         '/  Last row in the data range
Dim lngFinalColumn                              As Long         '/  Last Column in the data range

Dim arrTempArray()                              As Variant      '/  Temporarily holds the filtered information
Dim arrHeadingsRow()                            As Variant      '/  Holds the top (headings) row for application.match

Dim varMatchHolder                              As Variant      '/  Holds the application.match result

Dim lngCurrentColumn                            As Long         '/  The current column being copied

Dim strHeading                                  As String       '/  The current heading to search for
'/======================================================================================================================================================

'/ Create Array of Headings Row

'/ Check For Headings

'/ If not found

Call Array_Headings_Error_Handler(arrCurrentArray, strHeading)

End Sub

Public Sub Aggregate_Sheet_Data(ByRef arr1() As Variant, ByRef arr2() As Variant, ByRef arr3() As Variant, ByRef arr4() As Variant _
                                    , ByRef arr5() As Variant, ByRef arr6() As Variant, ByRef arr7() As Variant, ByRef arr8() As Variant)

'/======================================================================================================================================================
'/  Author:  Zak Armstrong
'/  Email:   zak.armstrong@company.co.uk
'/  Date:    13/August/2015
'/
'/  Is Called By:   Generate_Adviser_Report
'/
'/  Calls:          None
'/
'/  Description:    Aggregate the 8 filtered sheet arrays into one large array, then print to wsAggregatedData
'/
'/  Change Log:     | Author            | Date          | Description of Changes
'/                  -----------------------------------------------------------------------------------------------------------------------------------
'/                  |Zak armstrong      | 13.08.2015    | Wrote the Macro
'/                  |
'/                  |
'/======================================================================================================================================================
Dim rngTopLeftCell          As Range    '/ set the position for the table

Dim lngFirstrow             As Long     '/ Row of topleftcell
Dim lngFirstColumn          As Long     '/ column of topleftcell

Dim lngCurrentRow           As Long     '/ Current row of table

Dim lngFinalRow             As Long     '/ Boundaries of the table
Dim lngFinalColumn          As Long     '/

Dim I As Long
Dim J As Long
Dim K As Long

Dim rngTableRange           As Range    '/ for transferring array to sheet

Dim arrTransposedData()    As Variant  '/
'/======================================================================================================================================================

'/==================================================
'/ Set position of table
'/==================================================

'/==================================================
'/ Aggregate Data
'/==================================================

'/==================================================
'/ Transpose Data and print to worksheet
'/==================================================

'/==================================================
'/ Re-Populate arrAggregatedData with the transposed data
'/==================================================

End Sub

Public Sub Allocate_Business()

'/======================================================================================================================================================
'/  Author:  Zak Armstrong
'/  Email:   zak.armstrong@company.co.uk
'/  Date:    13/August/2015
'/
'/  Is Called By:   Generate_Adviser_Submissions_Report
'/
'/  Calls:          Allocation_error
'/
'/  Description:    For each piece of business in the aggregated data, assign to an adviser, month, type of business and provider in arrAllocatedBusiness
'/
'/  Notes:          I'm not particularly happy with the length, complexity or runtime of the main allocation procedure, but I've already re-designed it 3 times and this
'/                  one at least seems to work and handles errors properly and runs in only a few seconds.
'/
'/  Change Log:     | Author            | Date          | Description of Changes
'/                  -----------------------------------------------------------------------------------------------------------------------------------
'/                  |Zak armstrong      | 13.08.2015    | Started writing Macro
'/                  |zak Armstrong      | 14.08.2015    | Finished Writing Macro
'/                  |Zak Armstrong      | 17.08.2015    | Reviewed Macro, re-structured main allocation part to be less complicated and more resilient.
'/======================================================================================================================================================
Dim lngCurrentRow                               As Long         '/

Dim I                                           As Long         '/  General counters
Dim J                                           As Long         '/
Dim K                                           As Long         '/
Dim L                                           As Long         '/

Dim varAdviserPosition                          As Variant      '/  Positions in the allocated business array
Dim varMetricPosition                           As Variant      '/
Dim varDatePosition                             As Variant      '/
Dim varProviderPosition                         As Variant      '/

Dim varHeadingPosition                          As Variant      '/  Position in arrAggregatedData
Dim varMonthPosition                            As Variant      '/
Dim varMoneyReceivedPosition                    As Variant      '/
Dim varDateSubmittedPosition                    As Variant      '/
Dim varDateReceivedBankPosition                 As Variant      '/
Dim varLifeCoColumn                             As Variant      '/

Dim dtHolder                                    As Date         '/  Date Holder
Dim dblHolder                                   As Double       '/  Number holder
Dim strHolder                                   As String       '/  String holder
Dim varHolder                                   As Variant      '/  Variant Holder

Dim bTest1                                      As Boolean      '/  General testing
Dim bTest2                                      As Boolean      '/
Dim bTest3                                      As Boolean      '/
Dim bTest4                                      As Boolean      '/
Dim bTest5                                      As Boolean      '/

Dim rngWholeSheet                               As Range        '/  Range to contain all the data

Dim bTopLeftCellFound                           As Boolean      '/  Check to see if cell has been found

Dim lngLastPossibleCellRow                      As Long         '/  The last possible row
Dim lngLastPossibleCellColumn                   As Long         '/  The last possible column

Dim strTopLeftCellIdentifier                    As String       '/  The top left cell of the table

Dim lngRowsToSearch                             As Long
Dim lngColumnsToSearch                          As Long

Dim bMatchFound                                 As Boolean      '/

Dim bErrorFound                                 As Boolean      '/

Dim lngMonth                                    As Long         '/  The month the business corresponds to

Dim dblYearTotal                                As Double       '/  The whole year totals for each variable

Dim lngCounter                                  As Long         '/

Dim lngFirstrow                                 As Variant      '/  First row in the data range
Dim lngFirstColumn                              As Variant      '/  First column in the data range
Dim lngFinalRow                                 As Variant      '/  Last row in the data range
Dim lngFinalColumn                              As Variant      '/  Last Column in the data range

'/ Reminder:
'/ Structure: arrAllocatedBusiness
'/
'/          (0)               (1)                                                                       (5)
'/ (0)  |  [DateStamp]  | New Assets | Single Premiums | Monthly Premiums | Commission Generated | Commission Paid
'/ (1)  |  Adviser1     | ...
'/      |  Adviser2     | ...
'/      |  Adviser3     | ...
'/      |  ...          |
'/
'/ 3rd dimension: (0): [DateStamp] | [arrProviders] .....
'/ 4th dimension: (0): [DateStamp] | (1) Jan | (2) Feb | ... | (12) Dec | (13) Total
'/======================================================================================================================================================
'/==================================================
'/ Prepare arrAllocatedBusiness Headings
'/==================================================

'/==================================================
'/ Begin Main Loop
'/==================================================

            '/==================================================
            '/ Determine Adviser positions
            '/==================================================

                                    '/==================================================
                                    '/ Determine Metric Position
                                    '/==================================================

                                        '/==================================================
                                        '/ Determine Provider Position
                                        '/==================================================

                                            '/==================================================
                                            '/ Determine Date Position / configuration
                                            '/==================================================

                                            '/ Perform tests

                                                '/ bTest1

                                                '/ bTest2

                                                '/ bTest3

                                                '/ bTest4

                                                '/ bTest5

                                            '/ test combination of results for error conditions

                                                '/==================================================
                                                '/ Allocate non-recurring business
                                                '/==================================================

                                                    '/==================================================
                                                    '/ Allocate recurring business
                                                    '/==================================================

'/==================================================
'/ End Main Loop
'/==================================================
'/==================================================
'/ Calculate Totals
'/==================================================

End Sub

Public Sub Print_Adviser_Report()

'/======================================================================================================================================================
'/  Author:  Zak Armstrong
'/  Email:   zak.armstrong@company.co.uk
'/  Date:    14/August/2015
'/
'/  Is Called By:   Generate_Adviser_Submissions_Report
'/
'/  Calls:          None
'/
'/  Description:    For each relevant dimension of arrAllocatedBusiness, calculates the relevant totals
'/
'/
'/  Change Log:     | Author            | Date          | Description of Changes
'/                  -----------------------------------------------------------------------------------------------------------------------------------
'/                  |Zak armstrong      | 14.08.2015    | Wrote Macro
'/                  |
'/                  |
'/======================================================================================================================================================
Dim I                                           As Long         '/  General counters
Dim J                                           As Long         '/
Dim K                                           As Long         '/
Dim L                                           As Long         '/

Dim varAdviserPosition                          As Variant      '/ Positions in the array
Dim varMetricPosition                           As Variant      '/
Dim varDatePosition                             As Variant      '/
Dim varProviderPosition                         As Variant      '/

Dim strAdviser                                  As String       '/  The Adviser parameter
Dim strMetric                                   As String       '/  The Metric parameter + The Adviser Parameter
Dim strProvider                                 As String       '/  The provider parameter + the Metric Parameter + The Adviser Parameter
Dim varDate                                     As Variant      '/  The Date parameter

Dim strHolder                                   As String

Dim rngAnchorCell                               As Range        '/  The anchor for a table of the report

Dim lngAnchorRow                                As Long         '/
Dim lngAnchorColumn                             As Long         '/



Dim lngCurrentRow                               As Long         '/  Row counter
Dim lngRowsBetweenAdvisers                      As Long
Dim lngAdviserStartRow                          As Long

Dim bValueFound                                 As Boolean
Dim bMetricFound                                As Boolean
Dim dblHolder                                   As Double

Dim strFormula                                  As String

'/ Formattning Variables

Dim lngFinalColumn                              As Long

Dim LngAdviserNameRow                           As Long
Dim lngInvestmentRow                            As Long
Dim lngMonthlyPremiumRow                        As Long
Dim lngSinglePremiumRow                         As Long
Dim lngCommissionDueRow                         As Long
Dim lngCommissionPaidRow                        As Long
Dim lngRecurringStartRow                        As Long
Dim lngRecurringEndRow                          As Long

Dim rngFormat                                   As Range


'/ Reminder:
'/ Structure: arrAllocatedBusiness
'/
'/          (0)               (1)                                                                       (5)
'/ (0)  |  [DateStamp]  | New Assets | Single Premiums | Monthly Premiums | Commission Generated | Commission Paid
'/ (1)  |  Adviser1     | ...
'/      |  Adviser2     | ...
'/      |  Adviser3     | ...
'/      |  ...          |
'/
'/ 3rd dimension: (0): [DateStamp] | [arrProviders] .....
'/ 4th dimension: (0): [DateStamp] | (1) Jan | (2) Feb | ... | (12) Dec | (13) Total
'/======================================================================================================================================================

'/ Initialise stuff

    '/=================================================
    '/ Adviser Loop
    '/=================================================


    '/=================================================
            '/=================================================
            '/ Metric Loop
            '/=================================================


            '/=================================================
                    '/=================================================
                    '/ Provider Loop
                    '/=================================================


                    '/=================================================
                                    '/=================================================
                                    '/ Date Loop
                                    '/=================================================


                                    '/=================================================


                                    '/=================================================
                                    '/ End Date Loop
                                    '/=================================================

                                    '/=================================================
                    '/=================================================
                    '/ End Provider Loop
                    '/=================================================

                    '/=================================================
            '/=================================================
            '/ End Metric Loop
            '/=================================================

            '/=================================================
    '/=================================================
    '/ End Adviser Loop
    '/=================================================

    '/=================================================

End Sub

Public Sub Print_Provider_Report()

'/======================================================================================================================================================
'/  Author:  Zak Armstrong
'/  Email:   zak.armstrong@company.co.uk
'/  Date:    14/August/2015
'/
'/  Is Called By:   Generate_Adviser_Submissions_Report
'/
'/  Calls:          None
'/
'/  Description:    For each relevant dimension of arrAllocatedBusiness, calculates the relevant totals
'/
'/
'/  Change Log:     | Author            | Date          | Description of Changes
'/                  -----------------------------------------------------------------------------------------------------------------------------------
'/                  |Zak armstrong      | 14.08.2015    | Started writing Macro
'/                  |
'/                  |
'/======================================================================================================================================================
Dim I                                           As Long         '/  General counters
Dim J                                           As Long         '/
Dim K                                           As Long         '/
Dim L                                           As Long         '/

Dim varAdviserPosition                          As Variant      '/ Positions in the array
Dim varMetricPosition                           As Variant      '/
Dim varDatePosition                             As Variant      '/
Dim varProviderPosition                         As Variant      '/

Dim strAdviser                                  As String       '/  The Adviser parameter
Dim strMetric                                   As String       '/  The Metric parameter + The Adviser Parameter
Dim strProvider                                 As String       '/  The provider parameter + the Metric Parameter + The Adviser Parameter
Dim varDate                                     As Variant      '/  The Date parameter

Dim strHolder                                   As String

Dim rngAnchorCell                               As Range        '/  The anchor for a table of the report

Dim lngAnchorRow                                As Long         '/
Dim lngAnchorColumn                             As Long         '/

Dim lngCounter                                  As Long         '/

Dim lngCurrentRow                               As Long         '/  Row counter
Dim lngRowsBetweenProviders                     As Long

Dim bValueFound                                 As Boolean
Dim bAdviserFound                               As Boolean
Dim bMetricFound                                As Boolean
Dim bProviderFound                              As Boolean

Dim dblHolder                                   As Double

Dim strFormula                                  As String

'/ Formatting Variables

Dim lngFinalColumn                              As Long

Dim lngProviderNameRow                          As Long
Dim lngAdviserStartRow                          As Long
Dim lngAdviserEndRow                            As Long

Dim rngFormat                                   As Range

'/ Reminder:
'/ Structure: arrAllocatedBusiness
'/
'/          (0)               (1)                                                                       (5)
'/ (0)  |  [DateStamp]  | New Assets | Single Premiums | Monthly Premiums | Commission Generated | Commission Paid
'/ (1)  |  Adviser1     | ...
'/      |  Adviser2     | ...
'/      |  Adviser3     | ...
'/      |  ...          |
'/
'/ 3rd dimension: (0): [DateStamp] | [arrProviders] .....
'/ 4th dimension: (0): [DateStamp] | (1) Jan | (2) Feb | ... | (12) Dec | (13) Total
'/======================================================================================================================================================

'/ Similar to Adviser Report, but re-arranged somewhat

    '/=================================================
    '/ Provider Loop
    '/=================================================
    '/=================================================
                '/=================================================
                '/ Adviser Loop
                '/=================================================
                '/=================================================
                        '/=================================================
                        '/ Date Loop
                        '/=================================================
                        '/=================================================
                        '/=================================================
                        '/ End Date Loop
                        '/=================================================
                        '/=================================================
                '/=================================================
                '/ End Adviser loop
                '/=================================================
                '/=================================================
    '/=================================================
    '/ End Provider Loop
    '/=================================================
    '/=================================================

End Sub

Module 2: "v_2_M2_Auxilary_Subs"

Option Explicit
Option Compare Text

Public Sub Allocation_Error(lngCurrentRow As Long)

'/ Error Message / Details

End Sub

Public Sub Array_Position_Error()

'/ Error Message / Details

End Sub

Public Sub Insert_arrAscentric_LifeCo_Column(ByRef arrAscentric() As Variant)

'/ Insert a column into arrascentric with "Life Co" details

End Sub

Public Function Array_Position(ByVal varSearch As Variant, ByRef arrSearchArray() As Variant, ByVal lngNumberOfDimensions As Long, ByVal lngDimensionToSearch As Long, _
    Optional ByVal lngFirstDimensionLbound As Variant, Optional ByVal lngFirstDimensionUbound As Variant, _
    Optional ByVal lngSecondDimensionLbound As Variant, Optional ByVal lngSecondDimensionUbound As Variant, _
    Optional ByVal lngThirdDimensionLbound As Variant, Optional ByVal lngThirdDimensionUbound As Variant, _
    Optional ByVal lngFourthDimensionLbound As Variant, Optional ByVal lngFourthDimensionUbound As Variant, _
    Optional ByVal lngFifthDimensionLbound As Variant, Optional ByVal lngFifthDimensionUbound As Variant)

'/======================================================================================================================================================
'/  Author:  Zak Armstrong
'/  Email:   zak.armstrong@company.co.uk
'/  Date:    14/August/2015
'/
'/  Is Called By:   Allocate_Business_To_Adviser
'/
'/  Calls:          None
'/
'/  Description:    General "Find position of string in dimension of Array" Sub
'/
'/                  N.B. only accepts arrays up to 5 dimensions
'/
'/                  Returns null if no match found
'/======================================================================================================================================================

'/======================================================================================================================================================

End Function

Public Sub Open_Workbooks()

'/======================================================================================================================================================
'/  Author:  Zak Armstrong
'/  Email:   zak.armstrong@company.co.uk
'/  Date:    17/August/2015
'/
'/  Is Called By:   Generate_Adviser_Submissions_Report
'/
'/  Calls:          None
'/
'/  Description:    Checks that the workbooks are open. If not, tries to open them and checks again.
'/======================================================================================================================================================


End Sub

Module 3: v0_2_M3_Manual_Settings_or_Subs

Option Explicit
Option Compare Text

'/ Workbooks
Public wbSubsheet                                   As Workbook     '/ Contains all Company 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

'/ 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
Public wsOther                                      As Worksheet    '/ Misc. bits and pieces
Public wsMcOngoing                                  As Worksheet    '/ M's recurring product commissions e.g. insurance policies
Public wsJhOngoing                                  As Worksheet    '/ J'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 arrAggregatedData()                          As Variant      '/ An Array to hold the data from all worksheets
Public arrAllocatedBusiness()                       As Variant      '/ An array to hold all the Business, "all"ocated by adviser and by month

'/ Structure: arrAllocatedBusiness
'/
'/          (0)               (1)                                                                                       (6)
'/ (0)  |  [DateStamp]  | New Assets | Single Premiums | Monthly Premiums | Commission Generated | Commission Paid | Recurring
'/ (1)  |  Adviser1     | ...
'/      |  Adviser2     | ...
'/      |  Adviser3     | ...
'/      |  ...          |
'/
'/ 3rd dimension: (0): [DateStamp] | [arrProviders] .....
'/ 4th dimension: (0): [DateStamp] | (1) Jan | (2) Feb | ... | (12) Dec | (13) Total

Public arrProviders()                               As Variant      '/ will be populated with 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 colWorksheetNames                            As Collection   '/ The names of all the worksheets
Public colMetrics                                   As Collection   '/ Metrics in the final report

'/ Constants, and variables that should be constants
Public strCurrentDate                               As String                                                                   '/  The current Date for datestamping the saved report
Public strSavedReportFilename                       As String                                                                   '/  The filename to save the report as

Public Const strAdviserReportFilePath               As String = "S:\Company Admin Docs\Adviser Submission Reports\"               '/  The path of the folder containing the Adviser Report
Public Const strSavedReportsFilePath                As String = "S:\Company Admin Docs\Adviser Submission Reports\Saved Reports\" '/  The path of the folder containing previous reports
Public Const strSubsheetFilePath                    As String = "S:\Company Admin Docs\Subsheet and Commission statements\"       '/  The path of the folder containing the Subsheet

Public Const strAdviserReportFilename               As String = "Adviser Submissions Report.xlsm"                               '/  The filename of the Adviser Submissions Report
Public Const strSubsheetFilename                    As String = "Company Subsheet 2015.xlsm"                                      '/  The filename of the Subsheet

Public Const lngFinalCellRow                        As Long = 1048576                                                           '/  The last possible row
Public Const lngFinalCellColumn                     As Long = 16384                                                             '/  The last possible column

Public Sub Initialise_Worksheets()

'/======================================================================================================================================================
'/  Is called by:   Generate_Adviser_Submissions_Report
'/  Calls:          -
'/  Date:           10.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")

    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 Initialise_Collections_And_MetricHeadings()

'/======================================================================================================================================================
'/  Is called by:   Generate_Adviser_Submissions_Report
'/  Calls:          -
'/  Date:           10.08.2015
'/======================================================================================================================================================

Dim I As Long

    Set colWorksheetNames = New Collection

            '/ List of Strings to add

    Set colAllHeadings = New Collection
        '/ N.B. this will be the order of headings in the aggregated sheet

            '/ List of Strings to add

    For I = 1 To 12
        colAllHeadings.Add (DateValue("01/" & Right("0" & I, 2) & "/" & Year(Date)))
    Next I

    Set colMetrics = New Collection

            '/ List of Strings to add

End Sub

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

'/======================================================================================================================================================
'/  Author:  Zak Armstrong
'/  Email:   zak.armstrong@company.co.uk
'/  Date:    13/August/2015
'/
'/  Is Called By:   Filter_Sheet_Arrays
'/
'/  Calls:          None
'/
'/  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      '/  General error indicator
Dim colMissingSheetHeadings     As Collection   '/  For each sheet, contains the headings that shouldn't be there

Dim I                           As Long         '/  General Counters
Dim J                           As Long         '/
Dim K                           As Long         '/
'/======================================================================================================================================================

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

            '/ List of columns not in the worksheet

            For I = 1 To 12
                colMissingSheetHeadings.Add (DateValue("01/" & Right("0" & I, 2) & "/" & Year(Date)))
            Next I

                For I = 1 To colMissingSheetHeadings.Count
                    If strHeading = colMissingSheetHeadings(I) Then bErrorFound = False
                Next I

        '/ Same For each worksheet Case

        Case Else
            bErrorFound = True

    End Select

        If bErrorFound = True _
            Then
                MsgBox ("Couldn't find Column Heading: " & arrCurrentArray(0, 0) & ": " & strHeading)
                Debug.Print "Couldn't find Column Heading: " & arrCurrentArray(0, 0) & ": " & strHeading
                Exit Sub
        End If

End Sub

Public Sub Initialise_Providers_And_Advisers()

'/======================================================================================================================================================
'/  Author:  Zak Armstrong
'/  Email:   zak.armstrong@company.co.uk
'/  Date:    14/August/2015
'/
'/  Is Called By:   Generate_Adivser_Report
'/
'/  Calls:          None
'/
'/  Description:    Searches aggregated data, generates a list of all unique "Life Co" Provider Names and all Unique "Adviser" Names
'/======================================================================================================================================================
Dim lngCurrentRow                           As Long         '/ Current row of table
Dim lngCurrentColumn                        As Long         '/ The current column being copied

Dim lngFinalRow                             As Long         '/ Boundaries of the table
Dim lngFinalColumn                          As Long         '/

Dim I As Long
Dim J As Long
Dim K As Long

Dim arrHeadingsRow()                        As Variant      '/  Holds the top (headings) row for application.match

Dim varMatchHolder                          As Variant      '/  Holds the application.match result

Dim strHeading                              As String       '/  The current heading to search for
Dim strHolder                               As String       '/  The provider name to search for

Dim bMatchFound                             As Boolean      '/  Is the provider name already in the list?

Dim lngNameCounter                         As Long         '/
'/======================================================================================================================================================

lngFinalRow = UBound(arrAggregatedData, 1)
lngFinalColumn = UBound(arrAggregatedData, 2)

'/==================================================
'/ Determine "Life Co" column
'/==================================================

    lngCurrentColumn = Array_Position("Life Co", arrAggregatedData, 2, 2, 1, 1, "all", "all")

    If IsNull(lngCurrentColumn) _
        Then
            MsgBox "Couldn't find ""Life Co"" In arrAggregateddata"
            Debug.Print "Couldn't find ""Life Co"" In arrAggregateddata"
            End
    End If

'/==================================================
'/ Fill list of unique provider names
'/==================================================
    lngNameCounter = 0

    ReDim Preserve arrProviders(1 To 1)
        For lngCurrentRow = 2 To lngFinalRow
            bMatchFound = False
            strHolder = arrAggregatedData(lngCurrentRow, lngCurrentColumn)

            If strHolder = "" _
                Then
                    strHolder = "No Provider"
                    arrAggregatedData(lngCurrentRow, lngCurrentColumn) = "No Provider"
            End If


                For I = 1 To UBound(arrProviders)
                    If strHolder = arrProviders(I) Then bMatchFound = True
                Next I


            If bMatchFound = False _
                Then
                    lngNameCounter = lngNameCounter + 1
                    ReDim Preserve arrProviders(1 To lngNameCounter)
                    arrProviders(lngNameCounter) = strHolder
            End If

        Next lngCurrentRow

        ReDim Preserve arrProviders(1 To lngNameCounter + 1)
        arrProviders(lngNameCounter + 1) = "Ascentric"

'/==================================================
'/ Determine "Adviser" column
'/==================================================

    lngCurrentColumn = Array_Position("Adviser", arrAggregatedData, 2, 2, 1, 1, "all", "all")

    If IsNull(lngCurrentColumn) _
        Then
            MsgBox "Couldn't find ""Adviser"" In arrAggregateddata"
            Debug.Print "Couldn't find ""Adviser"" In arrAggregateddata"
            End
    End If

'/==================================================
'/ Deal with variations on names
'/==================================================

'' Replaces Adviser First Names with Full Names

'/==================================================
'/ Fill list of unique Adviser names
'/==================================================
    lngNameCounter = 0

    ReDim Preserve arrAdvisers(1 To 1)
        For lngCurrentRow = 2 To lngFinalRow
            bMatchFound = False
            strHolder = arrAggregatedData(lngCurrentRow, lngCurrentColumn)

                For I = 1 To UBound(arrAdvisers)
                    If strHolder = arrAdvisers(I) Then bMatchFound = True
                Next I

                    If bMatchFound = False _
                        Then
                            lngNameCounter = lngNameCounter + 1
                            ReDim Preserve arrAdvisers(1 To lngNameCounter)
                            arrAdvisers(lngNameCounter) = strHolder
                    End If

        Next lngCurrentRow

End Sub
\$\endgroup\$
  • 1
    \$\begingroup\$ The purpose of the code, as I understand it, per your description seems to be easily accomplished with a pivot table. That, or you need a database, not excel. \$\endgroup\$ – Raystafarian Aug 19 '15 at 14:22
  • \$\begingroup\$ Ooh. Pivot tables are a new one for me. Cursory glance: Yes, once I've got to the point of aggregating all the data, that would make things much simpler. \$\endgroup\$ – Kaz Aug 19 '15 at 14:26
  • \$\begingroup\$ Would still love any sage advice on designing VBA projects that I haven't implemented. \$\endgroup\$ – Kaz Aug 19 '15 at 14:26
  • \$\begingroup\$ The feature is still in its early stages and more of a beta/preview, but Rubberduck (an open-source VBE add-in) integrates Git source control into the VBE. Might be more interesting than having these funky module names ;-) \$\endgroup\$ – Mathieu Guindon Aug 19 '15 at 14:47
  • 1
    \$\begingroup\$ What is going on with the subs/functions that have a bunch of variables, but no other code? Also, it's already all aggregated on SubSheet which you can use for pivot tables. \$\endgroup\$ – Raystafarian Aug 19 '15 at 15:42
8
\$\begingroup\$

A wise programmer once told me

What a fascinating solution! It seems that for every smart decision you made, you also threw in a poor decision or two.

I now completely understand where he was coming from, because I feel the same way about this code here. It's a beautiful mix of good and bad decisions.

Let's look at Module 1.

Option Explicit
Option Compare Text '/ Case Insensitive

Off to a good start. You're using Option Explicit. I like that. I'm honestly not sure why the language design team ever made it an option at all.

Sub Generate_Adviser_Submissions_Report()

It's a good descriptive name, but it's got a few problems. First, it's implicitly public. We should be as explicit as possible about scope. Please don't make me remember what the default is, tell me. Secondly, I really don't like your underscore naming convention. You see, the underscore has a special place in VBA/VB6. It indicates one of two things.

  1. An event procedure.

    Button1_OnClick()
    
  2. An interface implementation.

    IEngine_Start()
    

Using underscores in regular methods confuses things and makes it hard impossible to pick these elements out just by glancing at the code.

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

That'll speed things up! Cool! But what happens if you get a runtime error? You're user is left with calculation set to manual and hopelessly confused as to why their formulas aren't updating. You really need an error handler here to make sure this stuff always get set back to the way it was. It's also best to capture the value of Application.Calculation to use for setting it back, because the user might have already had it set to manual, so again following the principle of least surprise, you wouldn't want to set it to automatic in the error handler, you'll want to restore it to whatever the user had it set to.

'/======================================================================================================================================================
'/  Author:  Zak Armstrong
'/  Email:   zak.armstrong@company.co.uk
'/  Date:    12/August/2015
'/  Version: 0.2

Cool! Now I know who to contact if I have a question about the code when I'm maintaining it.

'/  Is Called By:   None
'/
'/  Calls:          Open_Workbooks
'/                  Initialise_Worksheets
'/                  Initialise_Collections_And_MetricHeadings
'/                  Initialise_Providers_And_Advisers
'/                  Insert_arrAscentric_LifeCo_Column

Not so cool. These kinds of comments tend to lie because they never get maintained. If they do get maintained, they're just sucking up valuable development time. If you need to know what method is calling another, use an add-in like MZ-Tools or Rubberduck. There is a caveat to this. Those tools can't detect when a function is called as a UDF, from an Access Macro, or from an external VBA project in another workbook. In that case, I completely recommend you keep the "Is Called By" section, but repurpose it to documenting calls that can't be detected by software.

'/  Description:    All Company 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)

This is utterly fantastic. I wish more people (including myself) left these kind of purpose documenting comments.

'/  Change Log:     | Author            | Date          | Description of Changes

I get it. I do. It's hard to source control VBA code, but there are options out there (I created a few myself) and this change log doesn't really do much for you. You couldn't get the code back anyway. If you're going to keep a change log, use an external Excel workbook for the task. I'm just speaking from years of professional VBA development in a corporate environment. Life was just easier when we moved the change log out of the code. It removes the distraction of all the comments and lets you focus on the code.

Dim arrNewClient()                      As Variant      '/  An array to hold all data on the "New Client Investment" Sheet
Dim arrExistingClient()                 As Variant      '/  An array to hold all data on the "Existing Client Investment" Sheet
Dim arrGroupSchemes()                   As Variant      '/  An array to hold all data on the "Group Schemes" Sheet
Dim arrOther()                          As Variant      '/  An array to hold all data on the "Other" Sheet
Dim arrMcOngoing()                      As Variant      '/  An array to hold all data on the "MC Ongoing" Sheet
Dim arrJhOngoing()                      As Variant      '/  An array to hold all data on the "JH Ongoing" Sheet
Dim arrAegonQuilterArc()                As Variant      '/  An array to hold all data on the "AG-QU-ARC" Sheet
Dim arrAscentric()                      As Variant      '/  An array to hold all data on the "Ascentric" Sheet

This is so beautiful to look at. It really is, but how much time have you wasted making sure this all perfectly lines up? What if I wanted to rename a variable to make it more clear? Well, then I'd have to line all these back up again. I don't want to waste time doing that, so I won't give anything a better, clearer name... ever. The code will just rot because I don't want to mess with the formatting.

The other thing here is that while comments are excellent things and can provide clarity to otherwise unclear code, sometimes they're just clutter. Most of these end of line comments just repeat what the variable names already tell me. Useless.

Speaking of useless comments...

Dim I                                   As Long         '/  General counters
Dim J                                   As Long         '/
Dim K                                   As Long         '/

Yup. i, j, & k are counter variables. Every programmer every where knows this. No need for a comment, but why are we using uppercase for this? It's not wrong, it's just..... odd. It gives them an importance they just don't really have. They're counter variables, temporary, ephemeral,... unimportant. Use lowercase for them.

'/==================================================
'/ Initialise save Filename
'/==================================================
strCurrentDate = "." & Day(Date) & "." & Month(Date) & "." & Year(Date)
strSavedReportFilename = "Adviser Submissions Report" & strCurrentDate & ".xlsm"

You're going to need this snippet of code in every project at the office ever. Extract a method and tuck it some place where it's easy to reuse. Otherwise, you'll end up with this same code everywhere or with different file name formats everywhere.

'/==================================================
'/ Check that the workbooks are open
'/==================================================
Call Open_Workbooks
  1. Call is obsolete and useless. You can completely remove it and the behavior of the code doesn't change a bit.
  2. Does this method open workbooks, or check to see if they're open? I suspect it actually opens them, but if not, it should be named differently and be a function that returns a boolean.

Really, I just suspect the comment is lying and should be removed. The method name tells us everything that we need to know.

Call Sheet_Data_To_Array(wsNewClient, arrNewClient, "Adviser", 10, 10)
Call Sheet_Data_To_Array(wsExistingClient, arrExistingClient, "Adviser", 10, 10)
Call Sheet_Data_To_Array(wsGroupSchemes, arrGroupSchemes, "Adviser", 10, 10)
Call Sheet_Data_To_Array(wsOther, arrOther, "Adviser", 10, 10)
Call Sheet_Data_To_Array(wsMcOngoing, arrMcOngoing, "Adviser", 10, 10)
Call Sheet_Data_To_Array(wsJhOngoing, arrJhOngoing, "Adviser", 10, 10)
Call Sheet_Data_To_Array(wsAegonQuilterArc, arrAegonQuilterArc, "Adviser", 10, 10)
Call Sheet_Data_To_Array(wsAscentric, arrAscentric, "Account No", 10, 10)

Love it. You saw an opportunity to write a method and took it. However, what is the number 10? I have no context here to know. I'd have to lookup the definition of the method to find out. Secondly, if that value needed to change, do I change it in every place, or just half of them? I have no idea. If they always change together, then why do I pass it twice? If they can change separately, then you need not just one well named constant, but two.


Okay, so I'll stop short here, but the review was already getting quite long. I suspect that I'd just have more of the same to say about the other modules for now. You'll be a fine programmer someday. You have a great attention to detail, and that's actually your biggest problem right now. All those comments are getting in the way of your code. With a little practice, I think you'll start to see which comments are worth keeping and which ones should go the way of the dodo.

\$\endgroup\$
  • 1
    \$\begingroup\$ Ya know, I just read over this again and I think the fact that I mention the comments so often really highlights the issue. I barely even looked at the code because I was too distracted by all the comments. \$\endgroup\$ – RubberDuck Aug 22 '15 at 15:43
  • 1
    \$\begingroup\$ I just realised I forgot to say Thank You! All really useful advice. \$\endgroup\$ – Kaz Aug 25 '15 at 10:59

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.