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

• Ans: If I run the second loop over the first array resultColl using the resultWorkbook to display (and not Diming the resultDividedWorkbook it also works fine...

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.