# Speed up calculations with arrays/dictionaries

I've got a large macro which calculates diverse things for my job. I work in a contact center.

Firstly it writes people and forecast data. With this calculates if there are more/less people than it should (depending on the forecast). After this calculation Uses it to calculate the break time for everyone CalculadoraAux.

Once this is all done, the calculation starts(and is the slow block of the code). First for department and then for department and city(this last depends on the department and the number of people working on each city to distribuite things). It calculates for half hours and then 4 totals, grand total, morning, afternoon and night.

Hope I've explained myself kind of clearly, but I can answer anything you need to help me speed up this code:

Option Explicit
Sub Recalcular(Reforecast As Boolean)

Dim arrAgentes As Variant, wsTD As Worksheet, Comprueba As Boolean, Col As Integer, ColIAux, ColFAux, Reductores As Single, _
LastRow As Long, x As Long, i As Long, C As Range, y As Long, B As Byte, ColI, ColF, wsP As Worksheet, _
wsObj As Worksheet, arrKPI As Variant, arrKPI2 As Variant, A As Long, arrDescansos, _
DictModoDia As Scripting.Dictionary, arrPronosticos, wsPron As Worksheet, wsDescanso As Worksheet, STRUnion As String

'=========================FROM HERE============================='
Dim DictPronosticos As Scripting.Dictionary
Dim DictHojaPronosticos As Scripting.Dictionary
Dim DictModosDias As Scripting.Dictionary

Set DictPronosticos = New Scripting.Dictionary
Set DictModos = New Scripting.Dictionary
Set DictModoDia = New Scripting.Dictionary
Set DictHojaPronosticos = New Scripting.Dictionary
Set DictModosDias = New Scripting.Dictionary
Set wb = ThisWorkbook
Set ws = wb.Sheets("Programaciones")
Set wsP = wb.Sheets("Servicio")
Set wsObj = wb.Sheets("Objetivos")
Set wsPron = wb.Sheets("Pronosticos")
If Reforecast Then Set wsPron = wb.Sheets("PronosticosReforecast")
With ws
i = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("E5:BD" & i).ClearContents
End With
Call CrearTablaAgentes 'PivotTable Creation
LastRow = wsTD.Cells(wsTD.Rows.Count, 1).End(xlUp).Row
arrAgentes = wsTD.Range("A2:BC" & LastRow).Value 'Store PivotTable into array

'Dictionary
For i = LBound(arrAgentes) To UBound(arrAgentes)
If arrAgentes(i, 2) = vbNullString Then
ElseIf Not arrAgentes(i, 3) = vbNullString Then
STRUnion = Application.Proper(arrAgentes(i, 3)) & arrAgentes(i, 1) & arrAgentes(i, 2) & "1.Presentes Programados"
Else
STRUnion = "ALL" & arrAgentes(i, 1) & Mid(arrAgentes(i, 2), 7, Len(arrAgentes(i, 2))) & "1.Presentes Programados"
End If
Next i
wsTD.Delete

ColI = Array(5, 21, 37, 5)
ColF = Array(52, 36, 52, 20)
ColIAux = Array(13, 109, 205, 13)
ColFAux = Array(300, 204, 300, 108)

'Dictionary to know positions on some data
For Each C In wsP.Range("C35", wsP.Range("C35").End(xlDown))
If C.Font.Color = 49407 Then
End If
Next C

'Goal Data
With wsObj
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Rows(LastRow & ":1000").Delete
arrObjetivos = wsObj.UsedRange.Value
End With

'Dictionary to know where the goal positions are
For i = 2 To UBound(arrObjetivos)
Next i

'Main data to be calculated
With ws
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
arrMatriz = .Range("A5:BD" & LastRow).Value
End With

'Dictionary to know the position of each group
Set DictKPIModoDia = New Scripting.Dictionary
For i = 1 To UBound(arrMatriz)
DictKPIModoDia.Add arrMatriz(i, 1) & arrMatriz(i, 2) & arrMatriz(i, 3) & arrMatriz(i, 4), i
Next i

'Data
arrPronosticos = wsPron.UsedRange.Value

'Dictionary to know the position of each group
For i = 2 To UBound(arrPronosticos)
DictHojaPronosticos.Add arrPronosticos(i, 1) & arrPronosticos(i, 2) & arrPronosticos(i, 3) & arrPronosticos(i, 4), i
Next i

Dim Centro As String, Modo As String, Fecha As Date, KPI As String, Centros, Multiplicador As Single, CentroFuncion As String
For i = 1 To UBound(arrMatriz, 1)
'Rellenamos los pronósticos
Centro = arrMatriz(i, 1)
Modo = arrMatriz(i, 3)
Fecha = CDate(arrMatriz(i, 2))
KPI = arrMatriz(i, 4)
If DictPronosticos.Exists(KPI) Then
For A = 5 To 56
If DictHojaPronosticos.Exists(Centro & Fecha & Modo & KPI) Then
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = arrPronosticos(DictHojaPronosticos(Centro & Fecha & Modo & KPI), A)
Else
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = vbNullString
End If
Next A
End If
Next i

For i = 1 To UBound(arrMatriz, 1)
Centro = arrMatriz(i, 1)
Modo = arrMatriz(i, 3)
Fecha = CDate(arrMatriz(i, 2))
KPI = arrMatriz(i, 4)
If KPI = "1.Presentes Programados" Then
STRUnion = Centro & Fecha & Modo & KPI
For A = 5 To 56
On Error Resume Next
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = arrAgentes(DictModosDias(STRUnion), A - 1)
If arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = 0 Then arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = vbNullString
On Error GoTo 0
Next A
ElseIf KPI = "2.Efectivos" Then
For A = 5 To 52
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = Formulas(Fecha, Modo, KPI, A, i, arrDescansos, _
DictModoDia, Centro)
If arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = 0 Then arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = vbNullString
Next A
For A = 53 To 56
ReDim Contador(ColI(A - 53) To ColF(A - 53)) As Double
On Error Resume Next
Next Col
On Error GoTo 0
arrMatriz(i, A) = Application.Sum(Contador) / 2
If arrMatriz(i, A) = 0 Then arrMatriz(i, A) = vbNullString
Next A
ElseIf KPI = "94.Sobre/Infra" Then
For A = 5 To 56
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = Formulas(Fecha, Modo, KPI, A, i, arrDescansos, _
DictModoDia, Centro)
Next A
End If
Next i

ws.Range("A5:BD" & UBound(arrMatriz) + 4) = arrMatriz
Debug.Print Timer & "aux"
Debug.Print Timer & "aux"
'=========================TO HERE=============================' Fast Enough

'=========================FROM HERE============================='
wb.Sheets("Mapa Turnos").AutoFilterMode = False
arrDescansos = wsDescanso.UsedRange.Value
wsDescanso.Visible = xlSheetHidden
For i = 2 To UBound(arrDescansos)
If Not DictModoDia.Exists(arrDescansos(i, 1) & arrDescansos(i, 3)) Then
DictModoDia.Add arrDescansos(i, 1) & arrDescansos(i, 3), i
Else
DictModoDia(arrDescansos(i, 1) & arrDescansos(i, 3)) = DictModoDia(arrDescansos(i, 1) & arrDescansos(i, 3)) & ", " & i
End If
Next i
Dim SplitCentros, arrPorcentaje, m As Long, CentroCC As String, DictPorcentajeCentros As Scripting.Dictionary
Set DictPorcentajeCentros = New Scripting.Dictionary

'Calculate KPIs but the ones already calculated
For i = 1 To UBound(arrMatriz, 1)
Centro = arrMatriz(i, 1)
Modo = arrMatriz(i, 3)
Fecha = CDate(arrMatriz(i, 2))
KPI = arrMatriz(i, 4)
If Centro <> "ALL" And KPI = "1.Presentes Programados" Then  'aquí calculamos directamente las capacidades y el % según centro para llamadas y req
For A = 5 To 56
If arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), A) = 0 And Not A = 56 Then GoTo SiguienteCC
SplitCentros = Split(wb.Sheets("Servicio").Cells.Find(Modo).Offset(0, 1), "/")
ReDim arrPorcentaje(0 To UBound(SplitCentros))
For m = 0 To UBound(SplitCentros) 'Rellenamos Efectivos Finales para poder hacer el cálculo a todos
CentroCC = SplitCentros(m)
arrMatriz(DictKPIModoDia(CentroCC & Fecha & Modo & "21.Descansos Finales"), A) = _
Formulas(Fecha, Modo, "21.Descansos Finales", A, i, arrDescansos, DictModoDia, CentroCC)
arrMatriz(DictKPIModoDia(CentroCC & Fecha & Modo & "22.Efectivos Finales"), A) = _
Formulas(Fecha, Modo, "22.Efectivos Finales", A, i, arrDescansos, DictModoDia, CentroCC)
Next m
For m = 0 To UBound(SplitCentros)
On Error Resume Next
arrPorcentaje(m) = _
(arrMatriz(DictKPIModoDia(SplitCentros(m) & Fecha & Modo & "22.Efectivos Finales"), A) * 1800) / _
arrMatriz(DictKPIModoDia(SplitCentros(m) & Fecha & Modo & "6.TMO"), A)
On Error GoTo 0
Next m
'Porcentaje a aplicar
On Error Resume Next
DictPorcentajeCentros.RemoveAll
'Call Capacity
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "95.Call Capacity"), A) = _
arrMatriz(DictKPIModoDia("ALL" & Fecha & Modo & "95.Call Capacity"), A) * Multiplicador
'Pronóstico
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), A) = Multiplicador * _
arrMatriz(DictKPIModoDia("ALL" & Fecha & Modo & "5.Pronóstico"), A)
If arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "95.Call Capacity"), A) > _
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), A) Then
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "96.Call Capacity ajustado curva"), A) = _
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), A)
Else
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "96.Call Capacity ajustado curva"), A) = _
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "95.Call Capacity"), A)
End If
'Requeridos
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "92.Requeridos"), A) = Multiplicador * _
arrMatriz(DictKPIModoDia("ALL" & Fecha & Modo & "92.Requeridos"), A)
'NDA

arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "3.NA"), A) = Multiplicador * _
(arrMatriz(DictKPIModoDia("ALL" & Fecha & Modo & "3.NA"), A) * _
arrMatriz(DictKPIModoDia("ALL" & Fecha & Modo & "5.Pronóstico"), A)) / arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), A)
'NDS
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "4.SL"), A) = Multiplicador * _
(arrMatriz(DictKPIModoDia("ALL" & Fecha & Modo & "4.SL"), A) * _
arrMatriz(DictKPIModoDia("ALL" & Fecha & Modo & "5.Pronóstico"), A)) / arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), A)
'Descubierto
If arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), A) > 0 And _
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "22.Efectivos Finales"), A) = 0 Then _
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "93.Descubierto"), A) = "SI"
'Sobre/Infra
On Error Resume Next
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "94.Sobre/Infra"), A) = _
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "22.Efectivos Finales"), A) - _
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "92.Requeridos"), A)
'Occupancy
If A < 53 Then
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "97.Occ"), A) = _
(arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), A) * _
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "6.TMO"), A)) / _
(arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "22.Efectivos Finales"), A) * 1800)
If arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "97.Occ"), A) > 1 Then _
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "97.Occ"), A) = 1 'si el occupancy es mayor que 1
ElseIf A = 56 Then
KPI = "97.Occ"
GoTo Totales:
End If
SiguienteCC:
Next A
End If
If KPI = "92.Requeridos" Or KPI = "5.Pronóstico" Or DictPronosticos.Exists(KPI) Then GoTo SiguienteKPI
If KPI = "1.Presentes Programados" Or KPI = "2.Efectivos" Or Centro = "ALL" And KPI = "94.Sobre/Infra" Then GoTo SiguienteKPI
If Centro <> "ALL" And Not arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), 53) = 0 Then GoTo SiguienteKPI
For A = 5 To 52
arrMatriz(i, A) = Formulas(Fecha, Modo, KPI, A, i, arrDescansos, DictModoDia, Centro)
Next A
Totales:
'Totals
For A = 53 To 56
Select Case KPI
Case "93.Descubierto", "94.Sobre/Infra", "96.Call Capacity ajustado curva"
arrMatriz(i, A) = Formulas(Fecha, Modo, KPI, A, i, arrDescansos, DictModoDia, Centro)
Case "3.NA", "4.SL", "97.Occ"
ReDim arrKPI(ColI(A - 53) To ColF(A - 53))
ReDim arrKPI2(ColI(A - 53) To ColF(A - 53))
For Col = ColI(A - 53) To ColF(A - 53)
arrKPI2(Col) = arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), Col)
arrKPI(Col) = arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), Col)
Next Col
On Error Resume Next
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = Application.SumProduct(arrKPI, arrKPI2) / Application.Sum(arrKPI2)
On Error GoTo 0
Erase arrKPI
Erase arrKPI2
If arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) > 0 And arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) > 1 And Not KPI = "97.Occ" Then arrMatriz(i, A) = 1
Case "21.Descansos Finales"
On Error Resume Next
Reductores = arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "7.Formación"), A) + _
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "9.Ausencias no programadas"), A) + _
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "91.Otros"), A)
On Error GoTo 0
Contador = Split(DictModoDia(arrMatriz(i, 2) & arrMatriz(i, 3)), ", ")
arrMatriz(i, A) = 0
GoTo SiguienteKPI
End If
With wsDescanso
arrMatriz(i, A) = (Application.Sum(.Range(.Cells(Contador(0), ColIAux(A - 53)), _
End With
If arrMatriz(i, A) = 0 Then arrMatriz(i, A) = vbNullString
Case "1.Presentes Programados", "2.Efectivos", "22.Efectivos Finales"
ReDim Contador(ColI(A - 53) To ColF(A - 53)) As Double
On Error Resume Next
Next Col
On Error GoTo 0
arrMatriz(i, A) = Application.Sum(Contador) / 2
Case Else
ReDim arrKPI(ColI(A - 53) To ColF(A - 53))
For Col = ColI(A - 53) To ColF(A - 53)
arrKPI(Col) = arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "95.Call Capacity"), Col)
Next Col
arrMatriz(i, A) = Application.Sum(arrKPI)
If arrMatriz(i, A) = 0 Then arrMatriz(i, A) = vbNullString
Erase arrKPI
End Select
Next A

SiguienteKPI:

Next i

'=========================TO HERE=============================' Very slow and time consuming.

'Paste the array back to the worksheet
With ws
.Range("A5:BD" & UBound(arrMatriz) + 4) = arrMatriz
End With

End Sub


External functions such as CalculadoraAux or Formulas don't have effect on the executing time.

PS: there might be variables not declared here, but they are global variables (When I first started this I didn't know that shouldn't happen...)

Edit: Sample This will stay up for 7 days. This file takes about 57s to complete the calculation (is one of the fastest) before some changes it was taking 5-10 seconds which was the optimal time since the users click this button often.

• Are there 2 separate code blocks included? I see From Here and To Here twice. – pacmaninbw May 3 '19 at 12:59
• just to let you know where the process slows down. but its a single procedure. – Damian May 3 '19 at 13:03
• Do you have any sample data you can provide that will work with your code above? – PeterT May 7 '19 at 16:42
• @PeterT I uploaded a sample file the link is on my post. – Damian May 8 '19 at 11:39

Performance could improve by merging these two loops into one (inside the For A = 5 To 56 loop) and taking two of these DictKPIModoDia values to a variable (since they don't change inside the loop):

Dim upperBound as long
upperBound = UBound(SplitCentros)
For m = 0 To upperBound 'Rellenamos Efectivos Finales para poder hacer el cálculo a todos
CentroCC = SplitCentros(m)
arrMatriz(DictKPIModoDia(CentroCC & Fecha & Modo & "21.Descansos Finales"), A) = _
Formulas(Fecha, Modo, "21.Descansos Finales", A, i, arrDescansos, DictModoDia, CentroCC)
arrMatriz(DictKPIModoDia(CentroCC & Fecha & Modo & "22.Efectivos Finales"), A) = _
Formulas(Fecha, Modo, "22.Efectivos Finales", A, i, arrDescansos, DictModoDia, CentroCC)
'end of original first loop
On Error Resume Next 'here it is better to check that the denominator arrMatriz(DictKPIModoDia(CentroCC & Fecha & Modo & "6.TMO"), A) <> 0 instead of resuming next. If you really need this resume next, place it before the loop.
arrPorcentaje(m) = _
(arrMatriz(DictKPIModoDia(CentroCC & Fecha & Modo & "22.Efectivos Finales"), A) * 1800) / arrMatriz(DictKPIModoDia(CentroCC & Fecha & Modo & "6.TMO"), A)
On Error GoTo 0 'You probably don't need this, specially if you check above calculation for zero in the denominator
'end of original second loop
Next m


The other thing that might improve performance would be if you manage to incorporate this Totales: For A = 53 To 56 loop in your main A loop so that you don't have to loop again. Something like this:

'Occupancy
If A < 53 Then
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "97.Occ"), A) = _
(arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), A) * _
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "6.TMO"), A)) / _
(arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "22.Efectivos Finales"), A) * 1800)
If arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "97.Occ"), A) > 1 Then _
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "97.Occ"), A) = 1 'si el occupancy es mayor que 1
ElseIf A = 56 Then
KPI = "97.Occ"
'GoTo Totales: 'Commented out
Else '53 to 56
'Here, the code to calculate totals from A=53 to 56, ideally a call to a function. Ex:
CaculateKPI
End If


...

Public Sub CalculateKPI()
Select Case KPI
Case "93.Descubierto", "94.Sobre/Infra", "96.Call Capacity ajustado curva"
arrMatriz(i, A) = Formulas(Fecha, Modo, KPI, A, i, arrDescansos, DictModoDia, Centro)
Case "3.NA", "4.SL", "97.Occ"
ReDim arrKPI(ColI(A - 53) To ColF(A - 53))
ReDim arrKPI2(ColI(A - 53) To ColF(A - 53))
For Col = ColI(A - 53) To ColF(A - 53)
arrKPI2(Col) = arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), Col)
arrKPI(Col) = arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), Col)
Next Col
On Error Resume Next
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = Application.SumProduct(arrKPI, arrKPI2) / Application.Sum(arrKPI2)
On Error GoTo 0
Erase arrKPI
Erase arrKPI2
If arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) > 0 And arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) > 1 And Not KPI = "97.Occ" Then arrMatriz(i, A) = 1
Case "21.Descansos Finales"
On Error Resume Next
Reductores = arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "7.Formación"), A) + _
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "9.Ausencias no programadas"), A) + _
arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "91.Otros"), A)
On Error GoTo 0
Contador = Split(DictModoDia(arrMatriz(i, 2) & arrMatriz(i, 3)), ", ")
arrMatriz(i, A) = 0
GoTo SiguienteKPI
End If
With wsDescanso
arrMatriz(i, A) = (Application.Sum(.Range(.Cells(Contador(0), ColIAux(A - 53)), _
End With
If arrMatriz(i, A) = 0 Then arrMatriz(i, A) = vbNullString
Case "1.Presentes Programados", "2.Efectivos", "22.Efectivos Finales"
ReDim Contador(ColI(A - 53) To ColF(A - 53)) As Double
On Error Resume Next
Next Col
On Error GoTo 0
arrMatriz(i, A) = Application.Sum(Contador) / 2
Case Else
ReDim arrKPI(ColI(A - 53) To ColF(A - 53))
For Col = ColI(A - 53) To ColF(A - 53)
arrKPI(Col) = arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "95.Call Capacity"), Col)
Next Col
arrMatriz(i, A) = Application.Sum(arrKPI)
If arrMatriz(i, A) = 0 Then arrMatriz(i, A) = vbNullString
Erase arrKPI
End Select
End Sub

• I uploaded a sample file, the link is on my post. – Damian May 8 '19 at 11:40