Dear VBA-ers....

I'm struckling with an excel formula which counts unique values based on criteria in 2 other columns. The calculation of the formula works, but it takes a veeeeeeeeery long time, so perhaps a VBA code can do it faster.

Column.A exist of several location names.
Column.B exist of names which are related tot the location names in A.
Columnm.C exist of WeekNr's

In Column.D I need to count how many unique values in Column.A are related to the person in column.B in the same week in Column.C


Column.A Column.B Column.C Column.D
aa piet 3 3
aa piet 3 3
bb piet 3 3
cc piet 3 3

dd piet 4 1

dd kees 4 2
ee kees 4 2

ee klaas 4 1
ee klaas 4 1

ee klaas 5 2
ff klaas 5 2

So... if somebody can help me out :)

regards, Johan

Hi Johan,

Am Wed, 6 May 2020 11:18:35 -0700 (PDT) schrieb JS SL:

Column.A exist of several location names.
Column.B exist of names which are related tot the location names in A.
Columnm.C exist of WeekNr's

In Column.D I need to count how many unique values in Column.A are related to the person in column.B in the same week in Column.C

Column.A Column.B Column.C Column.D
aa piet 3 3
aa piet 3 3
bb piet 3 3
cc piet 3 3

dd piet 4 1

dd kees 4 2
ee kees 4 2

ee klaas 4 1
ee klaas 4 1

ee klaas 5 2
ff klaas 5 2

try in D2:

=SUM(1/COUNTIF(OFFSET($A$2,MATCH(B2&C2,$B$2:$B$100&$C$2:$ C$100,0)-1,,COUNTIFS($B$2:$B$20,B2,$C$2:$C$20,C2)),OFFSET($ A$2,MATCH(B2&C2,$B$2:$B$100&$C$2:$C$100,0)-1,,COUNTIFS($B$2:$B$20,B2,$C$2:$C$20,C2))))


Regards
Claus B.
--
Windows10
Office 2016

Claus,

Thx !!!

I'd translated the formula to my sheet;
Column A=E, B=N, C=N. It works well :) but..... it still cost many many hours to calculate. Is there a faster way (the fact is that the sheet has 200.000 records)

=SUM(1/COUNTIF(OFFSET($E$2;MATCH(N2&Q2;$N$2:$N$200000&$Q$ 2:$Q$200000;0)-1;;COUNTIFS($N$2:$N$200000;N2;$Q$2:$Q$200000;Q2)); OFFSET($E$2;MATCH(N2&Q2;$N$2:$N$200000&$Q$2:$Q$200 000;0)-1;;COUNTIFS($N$2:$N$200000;N2;$Q$2:$Q$200000;Q2))) )

regards, johan

Hi Johan,

Am Thu, 7 May 2020 06:12:24 -0700 (PDT) schrieb JS SL:

I'd translated the formula to my sheet;
Column A=E, B=N, C=N. It works well :) but..... it still cost many many hours to calculate. Is there a faster way (the fact is that the sheet has 200.000 records)

try this code:

Sub myCount()
Dim LRow As Long, i As Long
Dim Last As Long
Dim Res As Integer
Dim myRng As String

With ActiveSheet
LRow = .Cells(.Rows.Count, "E").End(xlUp).Row
For i = 2 To LRow
Last = i - 1 + Application.CountIfs(.Range("N:N"), _
.Cells(i, "N"), .Range("Q:Q"), .Cells(i, "Q"))
myRng = .Range(.Cells(i, "E"), .Cells(Last, "E")).Address
Res = Evaluate("=Sum(1 / CountIf(" & myRng & "," & myRng & "))")
.Range(.Cells(i, "R"), .Cells(Last, "R")) = Res
i = Last
Next
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016

Hi Johan,

Am Thu, 7 May 2020 22:13:46 +0200 schrieb Claus Busch:

try this code:

Sub myCount()

better:

Sub myCount()
Dim LRow As Long, i As Long
Dim Last As Long
Dim Res As Integer
Dim myRng As String

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
With ActiveSheet
LRow = .Cells(.Rows.Count, "E").End(xlUp).Row
For i = 2 To LRow
Last = i - 1 + Application.CountIfs(.Range("N:N"), _
.Cells(i, "N"), .Range("Q:Q"), .Cells(i, "Q"))
myRng = .Range(.Cells(i, "E"), .Cells(Last, "E")).Address
Res = Evaluate("=Sum(1 / CountIf(" & myRng & "," & myRng & "))")
.Range(.Cells(i, "R"), .Cells(Last, "R")) = Res
i = Last
Next
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016

Claus, thx !!

It runs very fast. 13000 records in a few second and the results are correct.
But..... after those 13000 it stops with an error on;
" myRng = .Range(.Cells(i, "E"), .Cells(Last, "E")).Address "

When using your earlier code it stops with an error on;
" Res = Evaluate("=Sum(1 / CountIf(" & myRng & "," & myRng & "))") "

After some investment I see that it stops when the WeekNumber become by the value 18. I'd changed 18 till 17, no problem. I'd changed it to 19... oeps. Everything which is identical/higher in column Q then 18 gives the run error.

regards, Johan

Hi Johan,

Am Sun, 10 May 2020 10:22:11 -0700 (PDT) schrieb JS SL:

It runs very fast. 13000 records in a few second and the results are correct.
But..... after those 13000 it stops with an error on;
" myRng = .Range(.Cells(i, "E"), .Cells(Last, "E")).Address "

When using your earlier code it stops with an error on;
" Res = Evaluate("=Sum(1 / CountIf(" & myRng & "," & myRng & "))") "

After some investment I see that it stops when the WeekNumber become by the value 18. I'd changed 18 till 17, no problem. I'd changed it to 19... oeps. Everything which is identical/higher in column Q then 18 gives the run error.

for me it works with all weeknumbers, also with numbers greater then 18.
That the code runs correctly the table must be sorted by weeknumber and
name.
If that doesn't help send me a demo workbook.


Regards
Claus B.
--
Windows10
Office 2016

Claus,

Thx.
I found the issue. I've got two brothers in de list in column N.
The names in the list are written as 'last name, first name'.
I'd skipped one of them and then it works.
In future I will set another letter in front of one of them.

regards, Johan