Why am I not just using a Pivot Table / Database? a) I've never ever used either before. And I don't have time to learn how before this project needs to actually be finished.b) The final output is going to be a report for the Company Directors. As such, the flexibility of choosing which bits of data to output in what format in which table on what sheet is highly useful.I already have my raw data aggregated, validated and consistently formatted in a single table. This part of the Macro takes each line and:Determines which Financial Adviser is involved.Determines what type of business is involved (investments, insurance, premiums, invoives, management fees etc.).Determines which Financial Service provider is involved, if any (e.g. insurance providers, fund managers etc.).Determines which month the business was transacted in.then aggregates the results into a 4-D array (Advisers, BusinessType, Providers, Month).I am aware that alongside a pivot table, learning how to use dictionaries and an actual database would be useful. Given that those weren't options here, is there any other feedback you can offer?N.B. I've tried to make my macro as robust as possible, so there's a lot of Find/Check position of <heading> in <Table/Array>. This report is going to primarily be used by other people, and absolutely has to be 100% accurate, so I feel it's warranted.Also, some of the basic methods aren't included here. You can safely assume that they do what they say they do.Module 10: M10_Allocate_BusinessPublic Sub AllocateBusinessToAdvisersProvidersMonthsAndMetrics()        PutSheetDataInArray WbAdviserReport, WsAggregatedData, ArrAggregatedData        FindAllAdvisers        FindAllProviders    ReDim ArrAllocatedBusiness(0 To UBound(ArrAdvisers), 0 To ColMetrics.Count, 0 To UBound(ArrProviders), 0 To 13)        PrepareAllocatedBusinessHeadings        AllocateAggregatedBusinessEnd SubPublic Sub FindAllAdvisers()    Dim arrHeadingsRow As Variant    Dim ixColumnHeading As Long    Dim arrAdviserColumn As Variant        arrHeadingsRow = RowFrom2dArray(ArrAggregatedData, 1)        ixColumnHeading = IndexInArray1d(arrHeadingsRow, Adviser)        arrAdviserColumn = ColumnFrom2dArray(ArrAggregatedData, ixColumnHeading)        ArrAdvisers = ListOfUniqueValues(arrAdviserColumn, True)End SubPublic Sub FindAllProviders()    Dim arrHeadingsRow As Variant    Dim ixColumnPosition As Long    Dim arrProviderColumn As Variant        arrHeadingsRow = RowFrom2dArray(ArrAggregatedData, 1)        ixColumnPosition = IndexInArray1d(arrHeadingsRow, Life Co)        arrProviderColumn = ColumnFrom2dArray(ArrAggregatedData, ixColumnPosition)        ArrProviders = ListOfUniqueValues(arrProviderColumn, True)End SubPublic Sub PrepareAllocatedBusinessHeadings()    Dim i As Long, j As Long, k As Long, l As Long    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        AssignArrayBounds ArrAllocatedBusiness, LB1, UB1, LB2, UB2, LB3, UB3, LB4, UB4        For i = LB1 + 1 To UB1            ArrAllocatedBusiness(i, 0, 0, 0) = ArrAdvisers(i)        Next i        For i = LB1 + 1 To UB1        For j = LB2 + 1 To UB2            ArrAllocatedBusiness(0, j, 0, 0) = ColMetrics(j)            ArrAllocatedBusiness(i, j, 0, 0) = ArrAdvisers(i) & Hyphen & ColMetrics(j)        Next j        Next i        For i = LB1 + 1 To UB1        For j = LB2 + 1 To UB2        For k = LB3 + 1 To UB3            ArrAllocatedBusiness(0, 0, k, 0) = ArrProviders(k)            ArrAllocatedBusiness(i, j, k, 0) = ArrAdvisers(i) & Hyphen & ColMetrics(j) & Hyphen & ArrProviders(k)        Next k        Next j        Next i        For l = LB4 + 1 To UB4 - 1            ArrAllocatedBusiness(0, 0, 0, l) = DateValue(01/ & Right(0 & Month(l), 2) & / & Year(Date))        Next l        ArrAllocatedBusiness(0, 0, 0, UB4) = YTDEnd SubPublic Sub AllocateAggregatedBusiness()    Dim i As Long, j As Long, k As Long    Dim row As Long    Dim lngFirstRow As Long, lngFinalRow As Long '/ Of the AggregatedData    Dim strTypeOfBusiness As String    Dim ixAdviserColumn     As Long    Dim ixProviderColumn    As Long    Dim ixDateSubmittedColumn       As Long    Dim ixInvestmentAmountColumn    As Long    Dim ixDateMoneyReceivedColumn   As Long    Dim ixMonthlyPremiumColumn      As Long    Dim ixSinglePremiumColumn       As Long    Dim ixCommissionDueColumn       As Long    Dim ixCommissionPaidColumn      As Long    Dim ixDateCommissionPaidColumn  As Long    Dim ixFirstMonthColumn          As Long    Dim ixAdviser   As Long    Dim ixMetric    As Long    Dim ixProvider  As Long    Dim ixMonth     As Long    Dim varSearchValue As Variant    Dim strErrorMessage As String        DetermineColumnPositions ixAdviserColumn, ixProviderColumn, ixDateSubmittedColumn, ixInvestmentAmountColumn, ixDateMoneyReceivedColumn, ixMonthlyPremiumColumn, _                                    ixSinglePremiumColumn, ixCommissionDueColumn, ixCommissionPaidColumn, ixDateCommissionPaidColumn, ixFirstMonthColumn            AssignArrayBounds ArrAggregatedData, lngFirstRow, lngFinalRow            lngFirstRow = lngFirstRow + 2            For row = lngFirstRow To lngFinalRow                strTypeOfBusiness = TypeOfBusiness(row, ixDateSubmittedColumn, ixInvestmentAmountColumn, ixDateMoneyReceivedColumn, ixMonthlyPremiumColumn, ixSinglePremiumColumn, _                                ixCommissionDueColumn, ixCommissionPaidColumn, ixDateCommissionPaidColumn, ixFirstMonthColumn)                Select Case strTypeOfBusiness                    Case Is = ColMetrics.Item(Investment Amount)                        DetermineAllocatedBusinessIndexes row, ixAdviser, ixAdviserColumn, ixMetric, ixInvestmentAmountColumn, ixProvider, ixProviderColumn, ixMonth, ixDateSubmittedColumn, strTypeOfBusiness                        AllocateBusiness ixInvestmentAmountColumn, ixAdviser, ixMetric, ixProvider, ixMonth, row                    Case Is = ColMetrics.Item(Single Premium)                        DetermineAllocatedBusinessIndexes row, ixAdviser, ixAdviserColumn, ixMetric, ixSinglePremiumColumn, ixProvider, ixProviderColumn, ixMonth, ixDateSubmittedColumn, strTypeOfBusiness                        AllocateBusiness ixSinglePremiumColumn, ixAdviser, ixMetric, ixProvider, ixMonth, row                    Case Is = ColMetrics.Item(Monthly Premium)                        DetermineAllocatedBusinessIndexes row, ixAdviser, ixAdviserColumn, ixMetric, ixMonthlyPremiumColumn, ixProvider, ixProviderColumn, ixMonth, ixDateSubmittedColumn, strTypeOfBusiness                        AllocateBusiness ixMonthlyPremiumColumn, ixAdviser, ixMetric, ixProvider, ixMonth, row                    Case Is = ColMetrics.Item(Invoice)                        DetermineAllocatedBusinessIndexes row, ixAdviser, ixAdviserColumn, ixMetric, ixCommissionDueColumn, ixProvider, ixProviderColumn, ixMonth, ixDateSubmittedColumn, strTypeOfBusiness                        AllocateBusiness ixCommissionDueColumn, ixAdviser, ixMetric, ixProvider, ixMonth, row                    Case Is = ColMetrics.Item(Recurring)                        For i = 1 To 12                            ixMonth = i                            DetermineAllocatedBusinessIndexes row, ixAdviser, ixAdviserColumn, ixMetric, ixFirstMonthColumn, ixProvider, ixProviderColumn, ixMonth, ixDateSubmittedColumn, strTypeOfBusiness                            AllocateBusiness ixFirstMonthColumn, ixAdviser, ixMetric, ixProvider, ixMonth, row                        Next i                End Select            Next rowEnd SubPublic Function TypeOfBusiness(ByVal row As Long, ByRef ixDateSubmittedColumn As Long, ByRef ixInvestmentAmountColumn As Long, ByRef ixDateMoneyReceivedColumn As Long, _                                    ByRef ixMonthlyPremiumColumn As Long, ByRef ixSinglePremiumColumn As Long, ByRef ixCommissionDueColumn As Long, _                                    ByRef ixCommissionPaidColumn As Long, ByRef ixDateCommissionPaidColumn As Long, ByRef ixFirstMonthColumn As Long) As String    Dim strBusiness     As String        strBusiness =     Dim bDateSubmittedIsPresent As Boolean    Dim bSubmittedAmountIsPresent As Boolean    Dim bMultipleBusinessTypesArePresent As Boolean    Dim bRecurringBusinessIsPresent As Boolean    Dim bCommissionIsPresent As Boolean    Dim bValuePresent As Boolean    Dim varElement As Variant    Dim i As Long    Dim arrAmountColumns As Variant        arrAmountColumns = Array()    ReDim arrAmountColumns(1 To 3, 1 To 2)        arrAmountColumns(1, 1) = ixInvestmentAmountColumn        arrAmountColumns(1, 2) = ColMetrics.Item(Investment Amount)        arrAmountColumns(2, 1) = ixSinglePremiumColumn         arrAmountColumns(2, 2) = ColMetrics.Item(Single Premium)        arrAmountColumns(3, 1) = ixMonthlyPremiumColumn        arrAmountColumns(3, 2) = ColMetrics.Item(Monthly Premium)    Dim LB1 As Long, UB1 As Long        AssignArrayBounds arrAmountColumns, LB1, UB1        varElement = ArrAggregatedData(row, ixDateSubmittedColumn)        bDateSubmittedIsPresent = (IsDate(varElement) And Not IsEmpty(varElement))        bSubmittedAmountIsPresent = False        For i = LB1 To UB1            varElement = ArrAggregatedData(row, arrAmountColumns(i, 1))            bValuePresent = (IsNumeric(varElement) And Not IsEmpty(varElement) And varElement <> 0)            If bValuePresent And bSubmittedAmountIsPresent Then bMultipleBusinessTypesArePresent = True            If bValuePresent And Not bSubmittedAmountIsPresent Then bSubmittedAmountIsPresent = True            If bValuePresent Then strBusiness = arrAmountColumns(i, 2)        Next i        For i = ixFirstMonthColumn To ixFirstMonthColumn + 11            varElement = ArrAggregatedData(row, i)            If (IsNumeric(varElement) And Not IsEmpty(varElement) And varElement <> 0) Then bRecurringBusinessIsPresent = True        Next i        If bRecurringBusinessIsPresent Then strBusiness = ColMetrics.Item(Recurring)        varElement = ArrAggregatedData(row, ixCommissionDueColumn)        bCommissionIsPresent = (IsNumeric(varElement) And Not IsEmpty(varElement) And varElement <> 0)        If Not (bSubmittedAmountIsPresent Or bRecurringBusinessIsPresent) And bCommissionIsPresent Then strBusiness = ColMetrics.Item(Invoice)        CheckErrorConditionsBusinessType row, bDateSubmittedIsPresent, bSubmittedAmountIsPresent, bMultipleBusinessTypesArePresent, bRecurringBusinessIsPresent, bCommissionIsPresent        TypeOfBusiness = strBusinessEnd FunctionPublic Sub CheckErrorConditionsBusinessType(ByVal row As Long, ByVal bDateSubmittedIsPresent As Boolean, ByVal bSubmittedAmountIsPresent As Boolean, _                                            ByVal bMultipleBusinessTypesArePresent As Boolean, ByVal bRecurringBusinessIsPresent As Boolean, ByVal bCommissionIsPresent As Boolean)    Dim bError As Boolean    Dim strErrorMessage As String    '/ Check for: Multiple types of submitted business, submitted and recurring, submitted without date, no business at all        bError = False        If bMultipleBusinessTypesArePresent _            Then                bError = True                strErrorMessage = strErrorMessage & Found Multiple Types of Submitted Business on line:  & row        End If        If bSubmittedAmountIsPresent And bRecurringBusinessIsPresent _            Then                bError = True                strErrorMessage = strErrorMessage & Found Submitted and Recurring Business on line:  & row        End If        If Not (bSubmittedAmountIsPresent Or bRecurringBusinessIsPresent Or bCommissionIsPresent) _            Then                bError = True                strErrorMessage = strErrorMessage & Could not find any submitted or recurring business on line:  & row        End If        If bSubmittedAmountIsPresent And Not bDateSubmittedIsPresent _            Then                bError = True                strErrorMessage = strErrorMessage & No Date Submitted for business on line:  & row        End If        If bError = True Then ErrorMessage strErrorMessageEnd SubPublic Sub DetermineAllocatedBusinessIndexes(ByVal row As Long, ByRef ixAdviser As Long, ByRef ixAdviserColumn As Long, ByRef ixMetric As Long, ByRef ixMetricColumn As Long, _                                                ByRef ixProvider As Long, ByRef ixProviderColumn As Long, ByRef ixMonth As Long, ByRef ixDateColumn As Long, ByRef strTypeOfBusiness As String)    Dim i As Long    Dim varSearchValue As Variant    Dim strErrorMessage As String    Dim lngDimension As Long    Dim arrMetrics As Variant        arrMetrics = Array()    ReDim arrMetrics(1 To ColMetrics.Count)        For i = 1 To ColMetrics.Count            arrMetrics(i) = ColMetrics(i)        Next i        varSearchValue = ArrAggregatedData(row, ixAdviserColumn)        ixAdviser = IndexInArray1d(ArrAdvisers, varSearchValue)        varSearchValue = ColMetrics.Item(strTypeOfBusiness)        ixMetric = IndexInArray1d(arrMetrics, varSearchValue)        varSearchValue = ArrAggregatedData(row, ixProviderColumn)        ixProvider = IndexInArray1d(ArrProviders, varSearchValue)        Select Case strTypeOfBusiness            Case Is <> ColMetrics.Item(Recurring)                ixMonth = 0                varSearchValue = ArrAggregatedData(row, ixDateColumn)                ixMonth = Month(varSearchValue)                If ixMonth = 0 _                    Then                        strErrorMessage = Could not determine month of  & varSearchValue &  on row:  & row                        ErrorMessage strErrorMessage                End If            Case Is = ColMetrics.Item(Recurring)                '/ do nothing        End SelectEnd SubPublic Sub AllocateBusiness(ByRef ixBusinessColumn As Long, ByRef ixAdviser As Long, ByRef ixMetric As Long, ByRef ixProvider As Long, ByRef ixMonth As Long, ByVal row As Long)    Dim i As Long, j As Long, k As Long    Dim strErrorMessage As String    Dim dblCurrentValue As Double    Dim dblAdditionalValue As Double    Dim dblNewValue As Double        dblCurrentValue = ArrAllocatedBusiness(ixAdviser, ixMetric, ixProvider, ixMonth)        dblAdditionalValue = ArrAggregatedData(row, ixBusinessColumn)        dblNewValue = dblCurrentValue + dblAdditionalValue        ArrAllocatedBusiness(ixAdviser, ixMetric, ixProvider, ixMonth) = dblNewValueEnd Sub
Creating a pseudo Pivot Table / Database using a 4-D array
array;vba;error handling;excel
Code is clean, the Hungarian naming is just slightly annoying, but variables have meaningful names, and that's good.If I had to bring up just one thing, I'd bring up the non-standard indentation. I see your patterns there, and you seem to be following some convention - but it's non-standard nonetheless: Dim and ReDim are executable statements just like any other, I'm not sure why you're doing this:    FindAllProvidersReDim ArrAllocatedBusiness(0 To UBound(ArrAdvisers), 0 To ColMetrics.Count, 0 To UBound(ArrProviders), 0 To 13)    PrepareAllocatedBusinessHeadingsNot a big thing, it's just... distracting.Also...    For i = LB1 + 1 To UB1    For j = LB2 + 1 To UB2    For k = LB3 + 1 To UB3       '...    Next k    Next j    Next iI see what you're doing, but I don't agree. Nested loops should look like nested loops, and them being indented as such makes it much easier to see:    For i = LB1 + 1 To UB1        For j = LB2 + 1 To UB2            For k = LB3 + 1 To UB3               '...            Next k        Next j    Next iStackin/aligning them the way you did, makes it look like you somewhat want to hide the fact that you've got a 3-layer nested loop going on.        Case Is = ColMetrics.Item(Recurring)            '/ do nothingWhy bother then? And if you're only ever going to run code when strTypeOfBusiness is not Recurring, then the Select Case block reeks of YAGNI here, a regular If block would raise fewer questions eyebrows, especially with a comment that explains why we only care about non-recurring business here, when other methods handle several types differently.Looking deeper, I'm not sure I like CheckErrorConditionsBusinessType at all. If should be returning that Boolean value (with an Optional ByRef outMessage = vbNullString), and leave it up to the caller to determine what to do with the return value, and whether to pop a messagebox or stick the message in the host app's statusbar.The conditions should all be mutually exclusive, or each block should include an early return (Exit Function) - otherwise you make it look like the last block is the most important one, because it will always execute and overwrite whatever validation errors occurred before that, effectively having executed as many lines of code and made as many assignments for no reason: just return and report the first error, and don't bother validating the other conditions - the validation has already failed anyway.