Count unique values with criteria (non-formula solution)

[sharky12345]

Morning guys,

I'm struggling to find a non formula solution to count unique values in a range but with criteria.

The range to count is A2:A5000 and the criteria range is B2:B5000, "Ports".

I know I can do this with a formula but I need to count for every cell in the range and this is going to be time consuming if I use a formula.

Can anyone offer a solution please?

 

[arthurbr]

Without a formula, perhaps filter with Power Query?

 

[Peter_SSs]

this is going to be time consuming if I use a formula.

What do you mean?
Perhaps I am not understanding the requirement but this formula takes well less than 0.1 seconds to calculate for me. Is that considered time consuming?

24 01 22.xlsm
	A	B	C	D
1
2	A261			480
3	A313
4	A54	Ports
5	A59	Ports
6	A483
7	A443
8	A297
9	A231
10	A274
11	A294
12	A394
13	A61
14	A17	Ports
15	A351	Ports
16	A309
17	A217
18	A409
19	A22
20	A177
21	A232	Ports
22	A86	Ports
23	A451	Ports
24	A8
25	A382	Ports
26	A90
27	A158	Ports
28	A90
29	A8
30	A328
31	A471
32	A102	Ports
33	A397
34	A409	Ports
35	A123
36	A55
37	A316
38	A195
39	A16	Ports
40	A234	Ports
41	A386	Ports
42	A11	Ports
43	A311	Ports
44	A306	Ports
45	A147	Ports
46	A95	Ports
47	A53	Ports
48	A85
49	A364	Ports
50	A5
Count Unique

Cell Formulas
Range	Formula
D2	D2	=SUMPRODUCT(--(B2:B5000="ports"),--(MATCH(A2:A5000&"|"&B2:B5000,A2:A5000&"|"&B2:B5000,0)=ROW(A2:A5000)-ROW(A2)+1))

Still, if that isn't fast enough then this is something like 10x faster on my machine.

Sub CountUniqueWithCriteria()
  Dim d As Object
  Dim a As Variant
  Dim i As Long, Cnt As Long

  Set d = CreateObject("Scripting.Dictionary")
  a = Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row).Value
  For i = 1 To UBound(a)
    If LCase(a(i, 2)) = "ports" Then d(a(i, 1)) = 1
  Next i
  Range("E2").Value = d.Count
End Sub

 

[sharky12345]

Got it, thanks guys!

 

[Peter_SSs]

You're welcome. Glad to help.