# Performance on countifs and sumifs

I'm trying to calculate with SUMIFS and COUNTIFS some data.

The output sheet looks like this:

I've hidden some irrelevant or sensitive data to make it easy to go to the point.

My code runs an array on this worksheet and calculates per each day and user some KPIs I need from this worksheet:

The calculation is pretty simple, but it impacts heavily on the performance:

Option Explicit
Sub Test()

With Hoja4
Dim arrTotal As Variant: arrTotal = .UsedRange.Value
Dim Fecha As Double
Dim i As Long
For i = 2 To UBound(arrTotal)
Fecha = arrTotal(i, 1)
arrTotal(i, 13) = CalculaLlamadas(CStr(arrTotal(i, 2)), Fecha, 1, 4)
arrTotal(i, 14) = CalculaFCR(CStr(arrTotal(i, 2)), Fecha, 1, 4)
arrTotal(i, 15) = CalculaLlamadas(CStr(arrTotal(i, 2)), Fecha, 3, 5)
arrTotal(i, 16) = CalculaFCR(CStr(arrTotal(i, 2)), Fecha, 3, 5)
arrTotal(i, 17) = CalculaLlamadas(CStr(arrTotal(i, 2)), Fecha, 30, 6)
arrTotal(i, 18) = CalculaFCR(CStr(arrTotal(i, 2)), Fecha, 30, 6)
Next i
.UsedRange.Value = arrTotal
End With

End Sub
Private Function CalculaFCR(Agente As String, Fecha As Double, Dias As Byte, Columna As Byte) As Long

Dim FechaFin As Double: FechaFin = Fecha + Dias
With Hoja37
CalculaFCR = Application.SumIfs(.Columns(Columna), .Columns(1), Agente, _
.Columns(2), ">=" & Fecha, .Columns(2), "<=" & FechaFin)
End With

End Function
Private Function CalculaLlamadas(Agente As String, Fecha As Double, Dias As Byte, Columna As Byte) As Long

Dim FechaFin As Double: FechaFin = Fecha + Dias
With Hoja37
.Range("B:B"), ">=" & Fecha, .Columns(2), "<=" & FechaFin)
End With

End Function


As you can see on the code, the logic is pretty easy calculate how many times an user shows between 2 dates, and get the sum of a column for these dates.

I can't figure out how to make this quicker, I've also tried using an array to loop through it instead using the countif and the sumif, but it takes even longer because the input sheet has 40k (1 and half month of data) rows and its likely to be increased with days to come.

Any suggestions on how to improve the performance for this task?

• How long does it run for? Have you identified a blottleneck? Why can't the sumifs/countifs be on the actual worksheet? Is Worksheet.UsedRange just the range you need or it's larger? I wouldn't consider it reliable - it'll break as soon as you enter any arbitrary scratchpad calculation anywhere to the right of the table. Commented Feb 25, 2020 at 21:10
• It runs for several minutes, the bottleneck is either the sumif/countif or looping through the whole array inevery iteration from the main array. I always delete rows and columns to avoid undesired data on my UsedRange so in this case is reliable. Do you have any guidance on how to improve this @MathieuGuindon? Commented Feb 25, 2020 at 21:24

You are generally correct in using Application functions (SumIfs and CountIfs) over rolling your own functions, as the built-in functions in Excel should be optimized in the DLL than anything you could write in VBA. The difference in performance is due to the organization of the data.

The key to my example below is to pre-process the input data into a form that reduces the "lookup" time of all the data. For comparison sake, using SumIfs and CountIfs will always be working with your entire data range. Your data set may be large (40k+ rows), so these Excel functions will always take a fixed amount of time. I timed my example to process 45,500 rows in 44.8 seconds. (I'll share a GenerateData sub that I created to set up the inputs for you or anyone else to double-check my work.)

The simple reccommendation for processing large amounts of data is to use a memory-based array. You're already doing this with your arrTotal array. There are two main issues in performance with this: 1) the Excel functions are still accessing the Worksheet object to process SumIfs and CountIfs, and 2) there is no optimization in the arrTotal data to help speed things up. This is where my own example starts.

First, I want to create an array from the input data that is "ordered". In this case, it means a memory-based array with the data sorted first on Agente and then on Fecha Completa. Please note that my code calculates the used area of the spreadsheet in a manner that should always be accurate (see @MathieuGuindon's comment). This function returns an ordered array:

Private Function OrderedInputs() As Variant
'--- first sort the input data by Agente, then by date
With Hoja37
Dim inputArea As Range
Dim lastRow As Long
lastRow = .Cells(.Rows.count, 1).End(xlUp).Row
Set inputArea = .Range("A2").Resize(lastRow - 1, 6)
With .Sort
.SortFields.Clear
Order:=xlAscending, DataOption:=xlSortNormal
Order:=xlAscending, DataOption:=xlSortNormal
.SetRange inputArea
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply

'--- now grab the data into a memory-based array
Dim inputData As Variant
inputData = inputArea.Value

'--- assuming the original data was sorted by date, then by Agente
'    we'll put it back
.SortFields.Clear
Order:=xlAscending, DataOption:=xlSortNormal
Order:=xlAscending, DataOption:=xlSortNormal
.SetRange inputArea
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
OrderedInputs = inputData
End Function


Having a sorted, ordered set of data is nice, but it's not nearly optimized enough yet. When you're processing this much data, you want to be able to immediately access any given agent's data. The way to do this is a Dictionary, using the agent's name as the key. Associated with each agent, is the date plus FCR1, FCR3, and FCR30 data values -- and there are multiple sets of this data for each agent. So for each agent, we can build a Collection of this data. The best way to do this is to create a simple object class called AgentData.

'--- Class: AgentData
Option Explicit

Public day As Date
Public fcr1 As Long
Public fcr3 As Long
Public fcr30 As Long


All the fields are public because you really don't need to manipulate the data going in or coming out. Building up a Collection of AgentData objects starts with looping through all the (ordered) input data by name, and creating a Collection entry for each date:

Private Function BuildAgentData(ByRef inputArray As Variant) As Dictionary
'--- we're creating a Dictionary of Agentes for quick lookup
'    each Item in the Dictionary is an ordered Collection of AgentData
'    objects, i.e. the objects are in date ascending order
Dim agentes As Dictionary
Set agentes = New Dictionary

Dim i As Long
Dim thisAgente As String
Dim allAgentData As Collection
For i = LBound(inputArray, 1) To UBound(inputArray, 1)
If thisAgente <> inputArray(i, 1) Then
thisAgente = inputArray(i, 1)
'--- create the first entry
Set allAgentData = New Collection
Else
'--- increase the size of the array by one and add the date
Set allAgentData = agentes(thisAgente)
End If
Next i
Set BuildAgentData = agentes
End Function


This reduces the beginning of your test sub to:

Dim sortedInputData As Variant
Dim agentes As Dictionary
sortedInputData = OrderedInputs()
Set agentes = BuildAgentData(sortedInputData)
Debug.Print "There are " & UBound(sortedInputData, 1) & " rows of input data."


There are changes to your Calcula functions, but the main test sub changes very little:

With Hoja4
Dim arrTotal As Variant: arrTotal = .UsedRange.Value
Dim fecha As Double
Dim i As Long
For i = 2 To UBound(arrTotal)
fecha = arrTotal(i, 1)
arrTotal(i, 13) = CalculaLlamadas2(sortedInputData, agentes, CStr(arrTotal(i, 2)), fecha, 1, 4)
arrTotal(i, 14) = CalculaFCR2(sortedInputData, agentes, CStr(arrTotal(i, 2)), fecha, 1, 4)
arrTotal(i, 15) = CalculaLlamadas2(sortedInputData, agentes, CStr(arrTotal(i, 2)), fecha, 3, 5)
arrTotal(i, 16) = CalculaFCR2(sortedInputData, agentes, CStr(arrTotal(i, 2)), fecha, 3, 5)
arrTotal(i, 17) = CalculaLlamadas2(sortedInputData, agentes, CStr(arrTotal(i, 2)), fecha, 30, 6)
arrTotal(i, 18) = CalculaFCR2(sortedInputData, agentes, CStr(arrTotal(i, 2)), fecha, 30, 6)
Next i
.UsedRange.Value = arrTotal
End With


Each of the Calcula functions will now use both the sortedInputData and the agentes dictionary as inputs. Instead of being forced to loop through all 40,000+ rows to count and sum for every single agent, the function immediately accesses the collection of data for each agent (via the Dictionary), and then can loop through the Collection (which may have as many entries as needed, but still is far, far less than the original input set).

Private Function CalculaFCR2(ByRef inputData As Variant, ByRef agentDates As Dictionary, _
ByVal agente As String, ByVal fecha As Date, _
ByVal dias As Long, ByVal columna As Long) As Long
Dim fechaFin As Date
fechaFin = fecha + dias
Dim sum As Long
If agentDates.Exists(agente) Then
Dim item As Variant
If (item.day >= fecha) And (item.day <= fechaFin) Then
Select Case columna
Case 4
sum = sum + item.fcr1
Case 5
sum = sum + item.fcr3
Case 6
sum = sum + item.fcr30
End Select
ElseIf (item.day > fechaFin) Then
Exit For
End If
Next item
CalculaFCR2 = sum
Else
'--- error processing if the agente doesn't exist
End If
End Function

Private Function CalculaLlamadas2(ByRef inputData As Variant, ByRef agentDates As Dictionary, _
ByVal agente As String, ByVal fecha As Date, _
ByVal dias As Long, ByVal columna As Long) As Long
Dim fechaFin As Date
fechaFin = fecha + dias
Dim count As Long
If agentDates.Exists(agente) Then
Dim item As Variant
If (item.day >= fecha) And (item.day <= fechaFin) Then
count = count + 1
ElseIf (item.day > fechaFin) Then
Exit For
End If
Next item
Else
'--- error processing if the agente doesn't exist
End If
End Function


I added a software timer class to measure execution time on my laptop (Intel Core i5-6300, 2.40GHz) and received the following results:

There are 4550 rows of input data.
Time to build ordered inputs: 0.078 seconds
Total Run Time: 4.407 seconds

There are 45500 rows of input data.
Time to build ordered inputs: 0.484 seconds
Total Run Time: 44.797 seconds


For reference, here are the three code modules you need to add:

Class: AgentData

'--- Class: AgentData
Option Explicit

Public day As Date
Public fcr1 As Long
Public fcr3 As Long
Public fcr30 As Long


Class: StopWatch

Option Explicit
'--- from https://stackoverflow.com/a/939260/4717755

Private mlngStart As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long

Public Sub StartTimer()
mlngStart = GetTickCount
End Sub

Public Function EndTimer() As Long
EndTimer = (GetTickCount - mlngStart)
End Function


Code Module: Module1

Option Explicit

Sub Test()
Dim sw As StopWatch
Set sw = New StopWatch
sw.StartTimer

Dim sortedInputData As Variant
Dim agentes As Dictionary
sortedInputData = OrderedInputs()
Set agentes = BuildAgentData(sortedInputData)
Debug.Print "There are " & UBound(sortedInputData, 1) & " rows of input data."
Debug.Print "Time to build ordered inputs: " & CDbl((sw.EndTimer / 1000#)) & " seconds"

With Hoja4
Dim arrTotal As Variant: arrTotal = .UsedRange.Value
Dim fecha As Double
Dim i As Long
For i = 2 To UBound(arrTotal)
fecha = arrTotal(i, 1)
arrTotal(i, 13) = CalculaLlamadas2(sortedInputData, agentes, CStr(arrTotal(i, 2)), fecha, 1, 4)
arrTotal(i, 14) = CalculaFCR2(sortedInputData, agentes, CStr(arrTotal(i, 2)), fecha, 1, 4)
arrTotal(i, 15) = CalculaLlamadas2(sortedInputData, agentes, CStr(arrTotal(i, 2)), fecha, 3, 5)
arrTotal(i, 16) = CalculaFCR2(sortedInputData, agentes, CStr(arrTotal(i, 2)), fecha, 3, 5)
arrTotal(i, 17) = CalculaLlamadas2(sortedInputData, agentes, CStr(arrTotal(i, 2)), fecha, 30, 6)
arrTotal(i, 18) = CalculaFCR2(sortedInputData, agentes, CStr(arrTotal(i, 2)), fecha, 30, 6)
Next i
.UsedRange.Value = arrTotal
End With
Debug.Print "Total Run Time: " & CDbl((sw.EndTimer / 1000#)) & " seconds"
End Sub

Private Function CalculaFCR2(ByRef inputData As Variant, ByRef agentDates As Dictionary, _
ByVal agente As String, ByVal fecha As Date, _
ByVal dias As Long, ByVal columna As Long) As Long
Dim fechaFin As Date
fechaFin = fecha + dias
Dim sum As Long
If agentDates.Exists(agente) Then
Dim item As Variant
If (item.day >= fecha) And (item.day <= fechaFin) Then
Select Case columna
Case 4
sum = sum + item.fcr1
Case 5
sum = sum + item.fcr3
Case 6
sum = sum + item.fcr30
End Select
ElseIf (item.day > fechaFin) Then
Exit For
End If
Next item
CalculaFCR2 = sum
Else
'--- error processing if the agente doesn't exist
End If
End Function

Private Function CalculaLlamadas2(ByRef inputData As Variant, ByRef agentDates As Dictionary, _
ByVal agente As String, ByVal fecha As Date, _
ByVal dias As Long, ByVal columna As Long) As Long
Dim fechaFin As Date
fechaFin = fecha + dias
Dim count As Long
If agentDates.Exists(agente) Then
Dim item As Variant
If (item.day >= fecha) And (item.day <= fechaFin) Then
count = count + 1
ElseIf (item.day > fechaFin) Then
Exit For
End If
Next item
Else
'--- error processing if the agente doesn't exist
End If
End Function

Private Function OrderedInputs() As Variant
'--- first sort the input data by Agente, then by date
With Hoja37
Dim inputArea As Range
Dim lastRow As Long
lastRow = .Cells(.Rows.count, 1).End(xlUp).Row
Set inputArea = .Range("A2").Resize(lastRow - 1, 6)
With .Sort
.SortFields.Clear
Order:=xlAscending, DataOption:=xlSortNormal
Order:=xlAscending, DataOption:=xlSortNormal
.SetRange inputArea
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply

'--- now grab the data into a memory-based array
Dim inputData As Variant
inputData = inputArea.Value

'--- assuming the original data was sorted by date, then by Agente
'    we'll put it back
.SortFields.Clear
Order:=xlAscending, DataOption:=xlSortNormal
Order:=xlAscending, DataOption:=xlSortNormal
.SetRange inputArea
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
OrderedInputs = inputData
End Function

Private Function BuildAgentData(ByRef inputArray As Variant) As Dictionary
'--- we're creating a Dictionary of Agentes for quick lookup
'    each Item in the Dictionary is an ordered Collection of AgentData
'    objects, i.e. the objects are in date ascending order
Dim agentes As Dictionary
Set agentes = New Dictionary

Dim i As Long
Dim thisAgente As String
Dim allAgentData As Collection
For i = LBound(inputArray, 1) To UBound(inputArray, 1)
If thisAgente <> inputArray(i, 1) Then
thisAgente = inputArray(i, 1)
'--- create the first entry
Set allAgentData = New Collection
Else
'--- increase the size of the array by one and add the date
Set allAgentData = agentes(thisAgente)
End If
Next i
Set BuildAgentData = agentes
End Function


And at the bottom of Module1 is the bonus sub to create the input data:

Sub GenerateData()
Dim names() As String
'--- from http://listofrandomnames.com/
names = Split("Lori,Norah,Valorie,Evita,Alden,Tressa,Carrol," & _
"Leeanna,Alexia,Marlyn,Wilhemina,Lanell,Kari," & _
"Rose,Arianne,Lesa,Royal,Maura,Sherie,Lahoma", ",")
Const START As Date = #1/1/2020#
Const FINISH As Date = #3/31/2020#
Const LOGINS_PER_DAY As Long = 500

'--- output setup
Dim entry As Range
Dim day As Date
Dim i As Long
Dim index As Long
With Hoja4
.Cells.Clear
.Range("A1").Value = "Fecha"
.Range("F1").Value = "Centro"
.Range("F1").Value = "Centro"
.Range("M1").Value = "Encuestas 1"
.Range("N1").Value = "FCR 1"
.Range("O1").Value = "Encuestas 3"
.Range("P1").Value = "FCR 3"
.Range("Q1").Value = "Encuestas 30"
.Range("R1").Value = "FCR 30"
Set entry = .Range("A2")
For day = START To FINISH
For i = LBound(names) To UBound(names)
entry.Cells(1, 1).Value = day
entry.Cells(1, 2).Value = names(i)
Set entry = entry.Offset(1, 0)
Next i
Next day
End With

'--- input setup
With Hoja37
.Cells.Clear
.Range("A1").Value = "Agente"
.Range("B1").Value = "Fecha Completa"
.Range("D1").Value = "FCR 1"
.Range("E1").Value = "FCR 3"
.Range("F1").Value = "FCR 30"
Set entry = .Range("A2")
For day = START To FINISH
For i = 1 To LOGINS_PER_DAY
index = CLng((UBound(names) - LBound(names)) * Rnd() + LBound(names))
entry.Cells(1, 1).Value = names(index)
entry.Cells(1, 2).Value = day
entry.Cells(1, 4).Value = IIf(Rnd() > 0.5, 1, 0)
entry.Cells(1, 5).Value = IIf(Rnd() > 0.5, 1, 0)
entry.Cells(1, 6).Value = IIf(Rnd() > 0.5, 1, 0)
Set entry = entry.Offset(1, 0)
Next i
Next day
End With
End Sub

• Upvoted ur answer Peter, will try it whenever possible, crazy days at work right now :( Commented Feb 28, 2020 at 7:36