Public 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

        AllocateAggregatedBusiness

End Sub

Public 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 Sub

Public 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 Sub

Public 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) = "YTD"

End Sub

Public 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 row

End Sub

Public 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 = strBusiness

End Function

Public 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 strErrorMessage

End Sub

Public 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 Select

End Sub

Public 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) = dblNewValue

End Sub