Excel: displaying an array, works fast for one array, slow for another

Question

I have a program that makes use of two arrays of Clients. It runs N simulations: for example, N is 1000, the program runs a loop 1000 times, each time generating and assigning a new random number and other data variables to clients in an array, for all the clients in an array. After the array is finished, it displays the clients and goes on to the next simulation.

I run into the following problem: while the loop for the first array runs relatively fast, the second loop is much slower. I tried figuring out why and it seems most of the time is consumed by displayRandomMatrix, in particular by these last lines:

RandomsRange.value = RandomsArray 
NamesRange.value = NamesArray
SimulationsNamesRange.value = SimulationsArray

I tried commenting the out and that resulted in a much higher speed. What I don't understand is why displayRandomMatrix is fast for the first array and is slow for the second, given the difference in their size is not huge: 242 vs 265.

Any suggestions and ideas are appreciated.

EDIT: The mcv:

Main sub:

Option Explicit

Sub StartDataCollectMcv()
'On Error GoTo CloseFiles
    Application.DisplayAlerts = False

    Dim ExcelApp As Object
    Set ExcelApp = getExcelApp()

    Dim clientsColl() As client
    ReDim clientsColl(1 To 242) As client

    Dim simulationNumber As Long
    simulationNumber = 100

    Dim i As Long
    For i = 1 To 242
        Set clientsColl(i) = New client
        clientsColl(i).setClientName = "Client_" & i
        clientsColl(i).setTotalDebt = 10000000
    Next


    Dim resultWorkbook As Workbook
    Set resultWorkbook = ExcelApp.Application.Workbooks.Open("your path2")

    Dim tempCount As Long
    tempCount = 1
    Dim clientCopy As Variant
    Dim simulation As Long

    Debug.Print tempCount & "/" & UBound(clientsColl) - _
        LBound(clientsColl) + 1

    For simulation = 1 To simulationNumber
        tempCount = 1
        For Each clientCopy In clientsColl
            clientCopy.setSimulationCount = simulationNumber

            clientCopy.setRandomNumber = Rnd()
            If clientCopy.getRandomNumber <= 0.5 Then
                clientCopy.setLoss = 10000000
                clientCopy.setProfit = 0
            Else
                clientCopy.setProfit = 3000000
                clientCopy.setLoss = 0
            End If


            Application.StatusBar = _
            "Calculating " & simulation & ", " & tempCount & _
            "/" & UBound(clientsColl) & clientCopy.getClientName
             tempCount = tempCount + 1

        Next

        Application.StatusBar = _
        "Calculating " & simulation & ", " & tempCount & _
        "/" & UBound(clientsColl) & " display"


        Call displayRandomMatrix(clientsColl, resultWorkbook, simulation)
    Next

    resultWorkbook.Save
    resultWorkbook.Close

    '**********************DIVIDED**********************
    Dim clientsDividedColl() As client
    clientsDividedColl = getDividedClients(clientsColl)

    Debug.Print "after getDividedClients"

    Dim resultDividedWorkbook As Workbook
    Set resultDividedWorkbook = ExcelApp.Application.Workbooks.Open("your path2")


    Erase clientsColl

    Dim countDivided As Long
    countDivided = 1

    For simulation = 1 To simulationNumber
        countDivided = 1

        For Each clientCopy In clientsDividedColl
            clientCopy.setRandomNumber = Rnd()

            If clientCopy.getRandomNumber <= 0.5 Then
                clientCopy.setLoss = 10000000
                clientCopy.setProfit = 0
            Else
                clientCopy.setProfit = 3000000
                clientCopy.setLoss = 0
            End If

            countDivided = countDivided + 1

            Application.StatusBar = simulation & ", " & _
                 countDivided & "/" & _
                UBound(clientsDividedColl) - LBound(clientsDividedColl) + 1 & _
                 ", " & clientCopy.getClientName & ", divided "
        Next


        Application.StatusBar = simulation & ", " & _
                 countDivided & "/" & _
                UBound(clientsDividedColl) - LBound(clientsDividedColl) + 1 & _
                 ", " & ", divided " & "display..."

        Call displayRandomMatrix(clientsDividedColl, resultDividedWorkbook, simulation)
    Next


    resultDividedWorkbook.Save
    resultDividedWorkbook.Close

    Application.StatusBar = "Done mcv!"
    MsgBox ("Done!")
CloseFiles:
    ExcelApp.Quit
End Sub

Display sub:

Option Explicit

Sub displayRandomMatrix(clientsColl() As client, resultWorkbook As Workbook, _
                                        simulation As Long)
        Dim RandomsRange As Range
        Dim NamesRange As Range
        Dim SimulationsNamesRange As Range

        Dim clientsCount As Long
        clientsCount = UBound(clientsColl) - LBound(clientsColl) + 1

        With resultWorkbook.Worksheets("matrix_random")

        Set RandomsRange = _
            .Range(.Cells(2, simulation + 1), .Cells(clientsCount + 1, simulation + 1))
        Set NamesRange = _
            .Range(.Cells(2, 1), .Cells(clientsCount + 1, 1))
        Set SimulationsNamesRange = _
                .Range(.Cells(1, simulation + 1), .Cells(1, simulation + 1))

        Debug.Print "RandomsRange: " & RandomsRange.Address
        Debug.Print "NamesRange: " & NamesRange.Address
        Debug.Print "SimulationsNamesRange: " & SimulationsNamesRange.Address

        Dim RandomsArray() As Double
        Dim NamesArray() As String
        Dim SimulationsArray() As Long

        ReDim RandomsArray(1 To clientsCount, 1 To 1)
        ReDim NamesArray(1 To clientsCount, 1 To 1)
        ReDim SimulationsArray(1 To 1)

        Dim clientRow As Long
        clientRow = 1

        Dim clientCopy As Variant
        For clientsCount = LBound(clientsColl) To UBound(clientsColl)
            RandomsArray(clientRow, 1) = _
                    clientsColl(clientsCount).getRandomNumber
            SimulationsArray(1) = simulation

            NamesArray(clientRow, 1) = _
                     clientsColl(clientsCount).getClientName
            clientRow = clientRow + 1


        Next

        RandomsRange.value = RandomsArray
        NamesRange.value = NamesArray
        SimulationsNamesRange.value = SimulationsArray

        End With
End Sub

Constructing the second array:

Option Explicit

Function getDividedClients(clientsColl() As client)
        Dim resultColl() As client
        ReDim resultColl(1 To _
                UBound(clientsColl) - LBound(clientsColl) + 1)

        Dim sumDebt As Double
        Dim averageDebt As Double
        sumDebt = 0

        Dim clientsCount As Long
        clientsCount = UBound(clientsColl) - LBound(clientsColl) + 1

        Dim p As Long
        p = 1
        Dim tempArray() As Variant
        ReDim tempArray(1 To clientsCount)

        Application.StatusBar = "calculating divided"
        Dim clientCopy As Variant
        For Each clientCopy In clientsColl
            If clientCopy.getTotalDebt <> -1 Then
                tempArray(p) = clientCopy.getTotalDebt
            Else
                tempArray(p) = Null
            End If

            p = p + 1
        Next


        averageDebt = _
                getSecondAverage(tempArray)


        Dim resultClient As client
        Dim clientCount As Variant
        Dim i As Long
        Dim residualDebt As Double

        Dim k As Long
        k = 0
        For Each clientCopy In clientsColl
            clientCopy.setAverageDebtInfo = averageDebt

            If k + 1 > UBound(resultColl) - LBound(resultColl) + 1 Then
                Debug.Print "before redim:  " & k
                ReDim Preserve resultColl(1 To k * 2) As client
                Debug.Print "redimed to " & k * 2
            End If

            If clientCopy.getTotalDebt <> -1 Then
                If clientCopy.getTotalDebt < averageDebt Or averageDebt = 0 Then
                    k = k + 1

                    Set resultColl(k) = clientCopy
                Else
                    residualDebt = clientCopy.getTotalDebt
                    clientCount = 0
                    Do While residualDebt > averageDebt
                        Set resultClient = New client
                        resultClient.copyData clientCopy
                        resultClient.setTotalDebt = averageDebt
                        resultClient.setTotalReserves = _
        resultClient.getTotalReservesRate * resultClient.getTotalDebt

                        resultClient.setTotalLoss = _
        resultClient.getTotalDebt * resultClient.getLossRatio * _
        resultClient.getTotalLgd - resultClient.getTotalReserves

                        resultClient.setTotalProfit = _
            resultClient.getTotalDebt * resultClient.getContractRate
                        If clientCount > 0 Then
                            resultClient.setClientName = _
                                clientCopy.getClientName & "_" & clientCount
                        Else
                            resultClient.setClientName = _
                                    clientCopy.getClientName
                        End If

                        k = k + 1

                        Set resultColl(k) = resultClient
                        residualDebt = residualDebt - averageDebt
                        clientCount = clientCount + 1
                    Loop

                    Set resultClient = New client
                    resultClient.copyData clientCopy
                    resultClient.setClientName = _
                                    clientCopy.getClientName & "_" & clientCount
                    resultClient.setTotalDebt = residualDebt

                    resultClient.setTotalReserves = _
        resultClient.getTotalReservesRate * resultClient.getTotalDebt

                    resultClient.setTotalLoss = _
           resultClient.getTotalDebt * resultClient.getLossRatio * _
           resultClient.getTotalLgd - resultClient.getTotalReserves

                    resultClient.setTotalProfit = _
                    resultClient.getTotalDebt * resultClient.getContractRate

                    k = k + 1

                    Set resultColl(k) = resultClient
                End If
                Debug.Print "k: " & k
            End If
        Next

        If k < UBound(resultColl) - LBound(resultColl) + 1 Then
            ReDim Preserve resultColl(1 To k)

            Debug.Print "final redimed to " & k
        End If

         Application.StatusBar = "divided done"
         getDividedClients = resultColl
End Function

Client class:

Option Explicit

Private clientname As String
Private identityNumber As String
Private creditRating As String

Private contractTenor As Long
Private contractNumber As String
Private contractRate As Double

Private totalReserves As Double
Private totalReservesRate As Double

Private debtType As String
Private totalDebt As Double

Private lossRatio As Double
Private totalLoss As Variant
Private totalProfit As Double

Private totalPd As Double
Private totalLgd As Double

Private simulationCount As Long
Private randomNumber As Double
Private outcome As Integer

Private loss As Double
Private profit As Double

Private averageDebtInfo As Double

Public Sub copyData(clientCopy As Variant)
    identityNumber = clientCopy.getIdentityNumber
    creditRating = clientCopy.getCreditRating

    contractTenor = clientCopy.getContractTenor
    contractNumber = clientCopy.getContractNumber
    contractRate = clientCopy.getContractRate

    lossRatio = clientCopy.getLossRatio
    totalReservesRate = clientCopy.getTotalReservesRate

    debtType = clientCopy.getDebtType
    totalDebt = clientCopy.getTotalDebt

    totalLoss = clientCopy.getTotalLoss
    totalPd = clientCopy.getTotalPd
    totalLgd = clientCopy.getTotalLgd

    averageDebtInfo = clientCopy.getAverageDebtInfo

End Sub

Private Sub Class_Initialize()
    simulationCount = 100
End Sub

'GET
Public Property Get getAverageDebtInfo()
    getAverageDebtInfo = averageDebtInfo
End Property


Public Property Get getLossRatio()
    getLossRatio = lossRatio
End Property

Public Property Get getTotalReservesRate()
    getTotalReservesRate = totalReservesRate
End Property

Public Property Get getProfit()
    getProfit = profit
End Property

Public Property Get getContractTenor()
    getContractTenor = contractTenor
End Property

Public Property Get getContractNumber()
    getContractNumber = contractNumber
End Property

Public Property Get getDebtType()
    getDebtType = debtType
End Property

Public Property Get getContractRate()
    getContractRate = contractRate
End Property

Public Property Get getTotalReserves()
    getTotalReserves = totalReserves
End Property

Public Property Get getLoss()
    getLoss = loss
End Property

Public Property Get getOutcome()
    getOutcome = outcome
End Property

Private Property Get getSimulationCount()
    getSimulationCount = simulationCount
End Property

Public Property Get getRandomNumber()
    getRandomNumber = randomNumber
End Property

Public Property Get getTotalLoss()
    getTotalLoss = totalLoss
End Property

Public Property Get getTotalProfit()
    getTotalProfit = totalProfit
End Property

Public Property Get getTotalDebt()
    getTotalDebt = totalDebt
End Property

Public Property Get getTotalLgd()
    getTotalLgd = totalLgd
End Property

Public Property Get getCreditRating()
    getCreditRating = creditRating
End Property

Public Property Get getTotalPd()
        getTotalPd = totalPd
End Property

Public Property Get getClientName() As String 'not used so far
    getClientName = clientname
End Property

Public Property Get getIdentityNumber()
    getIdentityNumber = identityNumber
End Property


'SET
Public Property Let setAverageDebtInfo(value As Double)
    averageDebtInfo = value
End Property

Public Property Let setSumProfits(value() As Double)
    sumProfits = value
End Property

Public Property Let setSumResults(value() As Double)
    sumResults = value
End Property

Public Property Let setLossRatio(value As Double)
    lossRatio = value
End Property

Public Property Let setTotalReservesRate(value As Double)
    totalReservesRate = value
End Property

Public Property Let setDebtType(value As String)
    debtType = value
End Property

Public Property Let setContractTenor(value As Long)
    contractTenor = value
End Property

Public Property Let setContractRate(value As Double)
    contractRate = value
End Property


Public Property Let setTotalReserves(value As Double)
    totalReserves = value
End Property

Public Property Let setContractNumber(value As String)
    contractNumber = value
End Property

Public Property Let setSumLosses(value() As Double)
    sumLosses = value
End Property

Public Property Let setSimulationCount(value As Double)
    simulationCount = value
End Property

Public Property Let setTotalLoss(value As Double)
    totalLoss = value
End Property

Public Property Let setTotalProfit(value As Double)
    totalProfit = value
End Property

Public Property Let setTotalDebt(value As Double)
    totalDebt = value
End Property

Public Property Let setTotalLgd(value As Double)
    totalLgd = value
End Property

Public Property Let setCreditRating(value As String)
        creditRating = value
End Property

Public Property Let setTotalPd(value As Double)
    totalPd = value
End Property

Public Property Let setIdentityNumber(value As String)
    identityNumber = value
End Property

Public Property Let setClientName(value As String)
    clientname = value
End Property

Public Sub generateRandom()
    randomNumber = Rnd()
    'Debug.Print "random: " & randomNumbers(i)
End Sub

Public Sub calculateOutcome()
    If totalPd <> -1 Then
        If randomNumber < totalPd Then
            outcome = 1
        Else
            outcome = 0
        End If
    Else
        outcome = Null
    End If
End Sub

Public Sub calculateFinancialResult()
    If outcome = 1 Then
        loss = totalLoss
        profit = 0
    ElseIf outcome = 0 Then
        loss = 0
        profit = totalProfit
    Else
        loss = Null
        profit = Null
    End If
End Sub


Public Property Let setProfit(value As Double)
    profit = value
End Property

Public Property Let setLoss(value As Double)
    loss = value
End Property

Public Property Let setRandomNumber(value As Double)
    randomNumber = value
End Property

Other functions:

Option Explicit

Function getExcelApp() As Object
        Dim ExcelApp As Object
        Set ExcelApp = CreateObject("Excel.Application")
        ExcelApp.Visible = False
        ExcelApp.ScreenUpdating = False
        ExcelApp.DisplayAlerts = False
        ExcelApp.EnableEvents = False

        Set getExcelApp = ExcelApp
End Function

Function getSecondAverage(tempArray() As Variant)


    Dim arr As Object
    Set arr = CreateObject("System.Collections.ArrayList")

    Dim elements_sum As Double
    elements_sum = 0
    Dim i As Long
    For i = LBound(tempArray) To UBound(tempArray)
        arr.Add tempArray(i)

        elements_sum = elements_sum + tempArray(i)
    Next

    arr.Sort
    arr.Reverse

    Dim percentile_value As Double
    percentile_value = _
        0.5 * elements_sum

    Dim accumulated_sum As Double
    accumulated_sum = 0

    Dim element As Variant
    For Each element In arr
        accumulated_sum = accumulated_sum + element

        If accumulated_sum >= percentile_value Then
            getSecondAverage = element
            Exit Function
        End If
    Next
End Function

Answer 1

Your 'Client' Class doesn't have three variables it needs: sumProfits, sumResults, sumLosses. It will not work without those.

---

First

1. Initial Run Time: 38.94 seconds.

2. Comment out all of the Application.StatusBar and Debug.Print lines.

3. New Run Time: 3.3 seconds

There's your hangup.

---

You are doing everything in arrays, which is great - that isn't going to be your bottleneck.

Why is clientCopy a Variant when it is for each in a collection of Client? Why not make it a Client?

In the display sub you use

NamesRange.value = NamesArray

For every loop. The names overwrite one another each iteration, why not just do that one time. You can also keep the range from the first time and just offset it by 1 column each loop instead of finding the range over and over.

---

One thing you might consider is that you know how many simulations and clients you want at the start. Right so your collection could be

ClientCollection(1 to numerOfClients, 1 to numberOfSimulation)

Now you can have a sub to populate them all within the class before they are loaded

Private Function PopulateClientCollection(ByVal numberOfClients As Long, ByVal numberOfSimulations As Long) As Client()
Dim clientRow As Long
Dim simulationRow As Long
For clientRow = 1 To numberOfClients
    For simulationRow = 1 To numberOfSimulations
        clientCollection(clientRow, simulationRow) = New Client
    Next
Next

And with your Initialize Client, you can create each client as a whole, set up all the calculations in the class and get it all loaded into your collection.

Then go back to the sheet and populate your range with your clients all at once.

---

To address your initial thought about these lines being slow

RandomsRange.value = RandomsArray 
NamesRange.value = NamesArray
SimulationsNamesRange.value = SimulationsArray

This is where you're writing to the sheet. You want to do this all at once, so resize your ranges to match your entire collection.

Then of course turn off ScreenUpdating while you load the sheet. Then back on afterwards.