Countifs via VBA Dictionary

[MK91]

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:

.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:

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

 

[DanteAmor]

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).

 

[MK91]

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
	A	B	C	D
1	KST	Year	Actual Value	Target
2	2039001301	2018	206	3
3	4000	2018	1	1
4	2039001307	2018	1	1
5	2039001301	2018	206	3
6	2039001301	2018	206	3
7	2039001300	2018	184	184
8	2039001300	2018	184	184
9	2039001300	2018	184	184
10	2039001300	2018	184	184
11	2039001300	2018	184	184
12	2039001300	2018	184	184
13	2039001300	2018	184	184
14	2039001300	2018	184	184
15	2039001300	2018	184	184
16	2039001300	2018	184	184
17	2039001300	2018	184	184
18	2039001300	2018	184	184
19	2039001300	2018	184	184
Tabelle1

Cell Formulas
Range	Formula
D2:D19	D2	=COUNTIFS($A:$A,$A2,$B:$B,$B2)

Cells with Data Validation
Cell	Allow	Criteria
C1	Any 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
	A	B	C	D
1	KST	Year	Actual Value	Target
2	2039001301	2018	206	3
3	4000	2018	1	1
4	2039001307	2018	1	1
5	2039001301	2018	206	3
6	2039001301	2018	206	3
7	2039001300	2018	184	184
8	2039001300	2018	184	184
9	2039001300	2019	206	203
10	2039001300	2019	206	203
11	5467	2019	1	1
12	2039001400	2019	7	7
13	2039001400	2019	7	7
14	2039001300	2020	204	204
15	2039001300	2020	204	204
16	2039001300	2020	204	204
17	2039001300	2020	204	204
Tabelle1

Cells with Data Validation
Cell	Allow	Criteria
C1	Any 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
	A	B	C	D
1	KST	Year	Actual Value	Target
2	2039001301	2018	206	veraltet
3	4000	2018	1	veraltet
4	2039001307	2018	1	veraltet
5	2039001301	2018	206	veraltet
6	2039001301	2018	206	veraltet
7	2039001300	2018	184	okay
8	2039001300	2018	184	okay
9	2039001300	2018	184	okay
10	2039001300	2018	184	okay
11	2039001300	2018	184	okay
12	2039001300	2018	184	okay
13	2039001300	2018	184	okay
14	2039001300	2018	184	okay
15	2039001300	2018	184	okay
16	2039001300	2018	184	okay
17	2039001300	2018	184	okay
18	2039001300	2018	184	okay
19	2039001300	2018	184	okay
20	2039001300	2018	184	okay
Tabelle1

Cell Formulas
Range	Formula
D2:D20	D2	=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
Cell	Allow	Criteria
C1	Any value

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

 

[kevin9999]

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.

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.

 

[DanteAmor]

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
	A	B	C
1	KST	Year	Target
2	2039001301	2018	3
3	4000	2018	1
4	2039001307	2018	1
5	2039001301	2018	3
6	2039001301	2018	3
7	2039001300	2018	13
8	2039001300	2018	13
9	2039001300	2018	13
10	2039001300	2018	13
11	2039001300	2018	13
12	2039001300	2018	13
13	2039001300	2018	13
14	2039001300	2018	13
15	2039001300	2018	13
16	2039001300	2018	13
17	2039001300	2018	13
18	2039001300	2018	13
19	2039001300	2018	13
Hoja1

Cell Formulas
Range	Formula
C2:C19	C2	=COUNTIFS($A:$A,$A2,$B:$B,$B2)

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

Sub CountIfs_2()
  Dim a As Variant, b As Variant
  Dim dic As Object
  Dim cad As String
  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"
    dic(cad) = dic(cad) + 1
  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

 

[MK91]

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

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

into

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

but it doesn't work.

 

[DanteAmor]

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
	A	B	C
1	KST	Year	Result
2	2039001301	2020	3
3	4000	2018	0
4	2039001307	2018	0
5	2039001301	2020	3
6	2039001301	2020	3
7	888899	2018	0
8	888899	2018	0
9	888899	2018	0
10	888899	2018	0
Hoja1

Cell Formulas
Range	Formula
C2:C10	C2	=COUNTIFS(A:A,A2,B:B,2020)

For the above, try this:

Sub CountIfs_2()
  Dim a As Variant, b As Variant
  Dim dic As Object
  Dim cad As String
  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

 

[MK91]

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".

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
	C												O	P	Q
2	ID												year	.	status
3	2039001301												2018		old
4	4000												2018		old
5	2039001307												2018		old
6	2039001301												2018		old
7	2039001301												2018		old
8	2039001300												2018		new
9	2039001300												2018		new
10	2039001300												2018		new
11	2039001300												2018		new
12	2039001300												2018		new
13	2039001300												2018		new
14	2039001300												2018		new
15	2039001300												2018		new
16	2039001300												2018		new
17	2039001300												2018		new
18	2039001300												2018		new
SAPimp

Cells with Data Validation
Cell	Allow	Criteria
Q2	Any value

 

[DanteAmor]

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

I'm glad to help you. Thanks for the feedback.