# Countifs via VBA Dictionary

#### MK91

##### New Member
Dear Excel-Experts,

After searching a lot on this an several other boards i came to ther conclusion to create an own post thread, because i can't find an answer for my specific question.

The problem/aim:
I'm trying to fasten up a macro containing countifs-formulas.
Some time ago i solved an similar problem on sumifs-formulas with an scripting-dictionary and get impressed by the speed. Now i want to realize countifs with dictionarys.

I found several examples on "countif" but only a very few on "countifs" and no one matching to my specific problem.

This formula should be replaced by dictionary:
VBA Code:
``.FormulaR1C1 = "=COUNTIFS(R3C3:R49557C3,RC3,R3C15:R49557C15,RC15)"``

The following variables are pulled out of an other sub:
WS_SAPimp = [Worksheet]
C_SAPimp__KST = C3 [integer]
C_SAPimp__Jahr = C15 [integer]
C_SAPimp__Status = C17 [integer]
Z_SAPimp__Start = R3 [long]
Z_SAPimp__End= R49557 [long]

Code:
VBA Code:
``````Dim dic As Object
Dim vARR_SAPimp As Variant
Dim r as long

With WS_SAPimp

Set dic = CreateObject("scripting.Dictionary")

For r= 1 To UBound(vARR_SAPimp)
With dic
.Item(vARR_SAPimp(r, C_SAPimp__KST) + vARR_SAPimp(r, C_SAPimp__Jahr)) = .Item(vARR_SAPimp(r, C_SAPimp__KST) + vARR_SAPimp(r, C_SAPimp__Jahr)) +1
End With
Next r

For r = 1 To UBound(vARR_SAPimp)
With dic
vARR_SAPimp(r,1) = .Item(vARR_SAPimp(r, C_SAPimp__KST) + vARR_SAPimp(r, C_SAPimp__Jahr))
End With
Next r

.Range(.cells(Z_SAPimp__Start, C_SAPimp__Status), .Cells(Z_SAPimp__End, C_SAPimp__Status)) = vARR_SAPimp

End With``````

This job will be done for ~50.000 rows+.
It's very fast and in the most rows it is counting correctly, but not in all of them and i don't know why.

In C3 (C_SAPimp__KST) are ids written, in C15 (C_SAPimp__Jahr) years. There are three years 2018-2020 and a lot of ids.
In example in the very first id it's giving me an incorrect solution (206 instead of 3) the following ids of this year (2018) are correct.
The first id in the next year (2019) is giving me also an incorrect solution. In the last year (2020) the solutions are correct.

I'm very new at scripting.dictionarys maybe an expert could show where is my mistake or show me on how to do this job better.
Please don't point to "pivot table" or "power pivot" ... because i want to learn something about the dictionary-methode.

Please excause my english, i hope you can understand my problem. It is a little bit hard to explain as an non native speaker.

Best regards
MK91

### Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Hi and welcome to MrExcel.

The macro you put in is incomplete or I don't fully understand it, whatever it is, it is throwing you wrong information.
You could give an example of about 20 lines of what you have on your sheet and the results you want. In the example use your formula countifs.
To put the example use the XL2BB tool minisheet (link in my signature).

Hi DanteAmor,

thank you for your kind welcome.

I expected i could be hard to understand my problem.

Okay here is an example of my sheet:
I deleted some columns to shorten it a bit. Column C (C3) in my first post = Column A; O (C15) = B; Q (C17) = C in the following code.
The green marked cells are correct - red ones incorrect. The column "actual value" was given by my posted macro.

203_Kostenanalyse_BWA_2021_Test.xlsb
ABCD
1KSTYearActual ValueTarget
2203900130120182063
34000201811
42039001307201811
5203900130120182063
6203900130120182063
720390013002018184184
820390013002018184184
920390013002018184184
1020390013002018184184
1120390013002018184184
1220390013002018184184
1320390013002018184184
1420390013002018184184
1520390013002018184184
1620390013002018184184
1720390013002018184184
1820390013002018184184
1920390013002018184184
Tabelle1
Cell Formulas
RangeFormula
D2:D19D2=COUNTIFS(\$A:\$A,\$A2,\$B:\$B,\$B2)
Cells with Data Validation
CellAllowCriteria
C1Any value

And here is an example to show my problem with the following year:
To show this to you i changed the formula in column "target" to value and shorten the table. In reality 2019 starts in row 16121 and 2020 in row 32352.

203_Kostenanalyse_BWA_2021_Test.xlsb
ABCD
1KSTYearActual ValueTarget
2203900130120182063
34000201811
42039001307201811
5203900130120182063
6203900130120182063
720390013002018184184
820390013002018184184
920390013002019206203
1020390013002019206203
115467201911
122039001400201977
132039001400201977
1420390013002020204204
1520390013002020204204
1620390013002020204204
1720390013002020204204
Tabelle1
Cells with Data Validation
CellAllowCriteria
C1Any value

In the final table i use an other formula:
But first i want to learn how to do "countifs" with dictionary...

203_Kostenanalyse_BWA_2021_Test.xlsb
ABCD
1KSTYearActual ValueTarget
220390013012018206veraltet
3400020181veraltet
4203900130720181veraltet
520390013012018206veraltet
620390013012018206veraltet
720390013002018184okay
820390013002018184okay
920390013002018184okay
1020390013002018184okay
1120390013002018184okay
1220390013002018184okay
1320390013002018184okay
1420390013002018184okay
1520390013002018184okay
1620390013002018184okay
1720390013002018184okay
1820390013002018184okay
1920390013002018184okay
2020390013002018184okay
Tabelle1
Cell Formulas
RangeFormula
D2:D20D2=IF(COUNTIFS(\$A:\$A,\$A2,\$B:\$B,MAX(\$B:\$B))>0,IF(COUNTIFS(\$A:\$A,\$A2,\$B:\$B,MAX(\$B:\$B)-1)>0,"okay","veraltet"),"veraltet")
Cells with Data Validation
CellAllowCriteria
C1Any value

I hope you understand my examples. Thank you very much in advance for your support.

I'm not sure if I fully understand the problems you're having, however, if I was tasked with using a Dictionary to calculate the COUNTIFS() in column D that matched the values in columns A & B - then this is the approach I'd take. Tested on 100k rows at ~0.6 seconds.

VBA Code:
``````Option Explicit
Sub CountIfs()
Dim i As Long, ConCat As String
Dim data, Result
Dim a As Double: a = Timer

data = Range("A2", Cells(Rows.Count, "B").End(xlUp))
ReDim Result(1 To UBound(data), 1 To 1)

With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(data)
ConCat = data(i, 1) & "|" & data(i, 2)  '<~~ concatenate the values in col A & B
.Item(ConCat) = .Item(ConCat) + 1
Next
For i = 1 To UBound(data)                 '<~~ fill the output array
Result(i, 1) = .Item(data(i, 1) & "|" & data(i, 2))
Next
End With

Range("D2").Resize(UBound(Result)) = Result '<~~ put the answer back to the sheet
MsgBox Timer - a & " seconds"
End Sub``````

All credit for the above code belongs to @Rick Rothstein who showed me this method.

Last edited:
Your results in your examples are not correct. I understand that you have thousands of data, but the result should be based on the example shown.
If this is your example, then this would be the result:
Dante Amor
ABC
1KSTYearTarget
2203900130120183
3400020181
4203900130720181
5203900130120183
6203900130120183
72039001300201813
82039001300201813
92039001300201813
102039001300201813
112039001300201813
122039001300201813
132039001300201813
142039001300201813
152039001300201813
162039001300201813
172039001300201813
182039001300201813
192039001300201813
Hoja1
Cell Formulas
RangeFormula
C2:C19C2=COUNTIFS(\$A:\$A,\$A2,\$B:\$B,\$B2)

Try the following code and fit the columns to your sheet.

VBA Code:
``````Sub CountIfs_2()
Dim a As Variant, b As Variant
Dim dic As Object
Dim i As Long

Set dic = CreateObject("Scripting.Dictionary")

a = Range("A2", Range("B" & Rows.Count).End(3))
ReDim b(1 To UBound(a, 1), 1 To 1)
For i = 1 To UBound(a, 1)
cad = a(i, 1) & "|" & a(i, 2)   '1 for column A, 2 for column "B"
Next
For i = 1 To UBound(a, 1)
b(i, 1) = dic(a(i, 1) & "|" & a(i, 2))
Next
Range("C2").Resize(UBound(b, 1)).Value = b
End Sub``````

Sorry about the confusion with my examples. I tried to adjust an sumifs-code to do the countifs job. I think i failed this way.

Thank you both Kevin & Dante. Your codes are nearly the same and are working perfectly for a simple countifs and will be very helpful for me.

Maybe you can help me by another question at the same topic:
How could i replace one condition to an constant value?

example:
Replace =COUNTIFS(\$A:\$A,\$A2,\$B:\$B,\$B2)
With =COUNTIFS(\$A:\$A,\$A2,\$B:\$B,"2020")

i tried to change
VBA Code:
`` ConCat = data(i, 1) & "|" & data(i, 2)``
into
VBA Code:
``ConCat = data(i, 1) & "|" & 2020)``
but it doesn't work.

ConCat = data(i, 1) & "|" & 2020)

The idea of the countif function is to count if it meets the condition.
In that line you are not verifying if it meets the condition, you are only adding a "2020" to the string.

Back to the same, you must put a sample of data and the results you need. Then you can apply the macro with the total of your data.
So if you have something like this:

Dante Amor
ABC
1KSTYearResult
2203900130120203
3400020180
4203900130720180
5203900130120203
6203900130120203
788889920180
888889920180
988889920180
1088889920180
Hoja1
Cell Formulas
RangeFormula
C2:C10C2=COUNTIFS(A:A,A2,B:B,2020)

For the above, try this:

VBA Code:
``````Sub CountIfs_2()
Dim a As Variant, b As Variant
Dim dic As Object
Dim i As Long

Set dic = CreateObject("Scripting.Dictionary")

a = Range("A2", Range("B" & Rows.Count).End(3))
ReDim b(1 To UBound(a, 1), 1 To 1)
For i = 1 To UBound(a, 1)
If a(i, 2) = 2020 Then
dic(a(i, 1)) = dic(a(i, 1)) + 1
End If
Next
For i = 1 To UBound(a, 1)
b(i, 1) = dic(a(i, 1))
Next
Range("C2").Resize(UBound(b, 1)).Value = b
End Sub``````

Thank you - i have learned a lot based on your answers.
This new information were very helpful to do my workaround and doing countifs for other tasks very very fast.

Here's my final result - maybe it could be helpful to some other readers in future:

My target was to mark all ids in column "c__year" as new (in c__status), if they appear in the last year or the year before in column "c__ID".
The variables: WS, r_Start, c__Start, r__End, c__End, c__year, c__ID are all declared by calling the sub "Info".

VBA Code:
``````Sub Status()
Dim dic As Object
Dim int_yearMAX As Integer, i As Long, ConCat As String
Dim data As Variant, Result As Variant

Call Info

Set dic = CreateObject("scripting.Dictionary")

With WS
int_yearMAX = Application.Max(.Columns(c__year))

data = .Range(.Cells(r__Start, c__Start), .Cells(r__End, c__End))

ReDim Result(1 To UBound(data), 1 To 1)
For i = 1 To UBound(data)
If data(i, c__year) = int_yearMAX Or data(i, c__year) = int_yearMAX - 1 Then
dic(data(i, c__ID)) = dic(data(i, c__ID)) + 1
End If
Next i

For i = 1 To UBound(data)
Result(i, 1) = dic(data(i, c__ID))

If Result(i, 1) > 0 Then
Result(i, 1) = "new"
Else
Result(i, 1) = "old"
End If
Next i

.Cells(r__Start, S_SAPimp__Status).Resize(UBound(Result)) = Result
End With
End Sub``````

203_Kostenanalyse_BWA_2021_Test.xlsb
COPQ
2IDyear.status
320390013012018old
440002018old
520390013072018old
620390013012018old
720390013012018old
820390013002018new
920390013002018new
1020390013002018new
1120390013002018new
1220390013002018new
1320390013002018new
1420390013002018new
1520390013002018new
1620390013002018new
1720390013002018new
1820390013002018new
SAPimp
Cells with Data Validation
CellAllowCriteria
Q2Any value

Thank you - i have learned a lot based on your answers.

Replies
5
Views
354
Replies
20
Views
992
Replies
2
Views
442
Replies
3
Views
342
Replies
24
Views
3K

1,203,045
Messages
6,053,188
Members
444,644
Latest member
keepontruckinc4

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back