VBA code for Distinct Count

[Michael Fowler]

Need help with two things ... (1) VBA code for Distinct Count of Values in a Column, and (2) VBA code for Distinct Count of Values in a Column, but with a condition from another Column (in effect, a Distinct CountIf).

Thanks in advance.

 

[Eric W]

Both of those are easy to do with a formula. For example:

Book1
	A	B	C	D	E
1	Value	Condition		# Unique	# Unique w/1
2	A	1		5	3
3	B	2
4	C	1
5	D	2
6	E	1
7	A	1
8	B	2
9	C	1
10	D	2
11	E	1
12	A	1
13	B	2
14	C	1
15	D	2
16	E	1
Sheet1

Cell Formulas
Range	Formula
D2	D2	=ROWS(UNIQUE(A2:A16))
E2	E2	=ROWS(UNIQUE(FILTER(A2:A16,B2:B16=1)))

So you could write this in a VBA program using the Evaluate function:

MyCount = EVALUATE("=ROWS(UNIQUE(A2:A16))")

The "traditional" way of writing it would be to find the last row, set up a loop and check each row. Something like:

Sub Test1()
Dim lr As Long, r As Long, MyDic As Object, MyDic2 As Object

    Set MyDic = CreateObject("Scripting.Dictionary")
    Set MyDic2 = CreateObject("Scripting.Dictionary")
    
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
    For r = 2 To lr
        MyDic(Cells(r, "A")) = MyDic(Cells(r, "A")) + 1
        If Cells(r, "B") = 2 Then MyDic2(Cells(r, "B")) = MyDic2(Cells(r, "B")) + 1
    Next r
    
    Debug.Print MyDic.Count, MyDic2.Count
End Sub

But that's likely to be less efficient than the EVALUATE, which is less efficient than the sheet formula. I assume you're looking for techniques, not a specific macro here. If so, what exactly is your final goal?

 

[Michael Fowler]

Both of those are easy to do with a formula. For example:

Book1
	A	B	C	D	E
1	Value	Condition		# Unique	# Unique w/1
2	A	1		5	3
3	B	2
4	C	1
5	D	2
6	E	1
7	A	1
8	B	2
9	C	1
10	D	2
11	E	1
12	A	1
13	B	2
14	C	1
15	D	2
16	E	1
Sheet1

Cell Formulas
Range	Formula
D2	D2	=ROWS(UNIQUE(A2:A16))
E2	E2	=ROWS(UNIQUE(FILTER(A2:A16,B2:B16=1)))

So you could write this in a VBA program using the Evaluate function:

MyCount = EVALUATE("=ROWS(UNIQUE(A2:A16))")

The "traditional" way of writing it would be to find the last row, set up a loop and check each row. Something like:

Sub Test1()
Dim lr As Long, r As Long, MyDic As Object, MyDic2 As Object

    Set MyDic = CreateObject("Scripting.Dictionary")
    Set MyDic2 = CreateObject("Scripting.Dictionary")
   
    lr = Cells(Rows.Count, "A").End(xlUp).Row
   
    For r = 2 To lr
        MyDic(Cells(r, "A")) = MyDic(Cells(r, "A")) + 1
        If Cells(r, "B") = 2 Then MyDic2(Cells(r, "B")) = MyDic2(Cells(r, "B")) + 1
    Next r
   
    Debug.Print MyDic.Count, MyDic2.Count
End Sub

But that's likely to be less efficient than the EVALUATE, which is less efficient than the sheet formula. I assume you're looking for techniques, not a specific macro here. If so, what exactly is your final goal?

Hi Eric. The reason I can't pre-write the formula is because it would be referencing cells that are going to be deleted as part of a macro when run, and hence it would return #N/A. So I want to have the macro do all its deleting and then get VBA to insert the Count Distinct at the end of the macro.

 

[Michael Fowler]

Hi again Eric. Some more info : This is what the formula would be if the range wasn't dynamic ...
=SUMPRODUCT(1/COUNTIF('Subledger Data'!H2:H300,'Subledger Data'!H2:H300))
... but it my case the "300" will be changing each time, due to rows being deleted earlier in the macro.

 

[Peter_SSs]

Couldn't you use something like this, using any number that will be bigger than any data you will ever have in column H of 'Subledger data' where I have used 1000?
For the moment I have assumed that there will always be at least one non-blank cell in the range.

Sub Test()
  Dim MyCount As Long
  
  With Sheets("Subledger Data").Range("H2:H1000")
    MyCount = .Worksheet.Evaluate(Replace("rows(unique(filter(#,#<>"""")))", "#", .Address))
  End With
End Sub

 

[Peter_SSs]

The reason I can't pre-write the formula is because it would be referencing cells that are going to be deleted as part of a macro when run,

What about this formula then? Again just ensuring where I have 1000 use a number that will be bigger than any remaining rows in the relevant range after your macro has deleted rows.

=LET(c,'Subledger Data'!H:H,r,INDEX(c,2):INDEX(c,1000),ROWS(UNIQUE(FILTER(r,r<>""))))

 

[Michael Fowler]

What about this formula then? Again just ensuring where I have 1000 use a number that will be bigger than any remaining rows in the relevant range after your macro has deleted rows.

=LET(c,'Subledger Data'!H:H,r,INDEX(c,1):INDEX(c,1000),ROWS(UNIQUE(FILTER(r,r<>""))))

Hi Peter, thanks for helping me, but neither option worked. Your first suggestion (Sub Test) yielded the debugger, and in the second option it seems to not know what the "c" and "r'" in the formula are (as I don't).

 

[Peter_SSs]

Hi Peter, thanks for helping me, but neither option worked. Your first suggestion (Sub Test) yielded the debugger, and in the second option it seems to not know what the "c" and "r'" in the formula are (as I don't).

Then are you actually working with Excel 365 or 2021 as shown in your profile?

 

[Michael Fowler]

Presently I'm in the work office on Excel 2016. (I'm on 2021 at home.)

 

[Peter_SSs]

Presently I'm in the work office on Excel 2016. (I'm on 2021 at home.)

1. Hmm, the suggestions offered have been based on what is shown in your profile. If you need your question answered for different versions it obviously would be best to state that in the first post of a thread.
2. Do you need this solution for work or for home?
3. If you are on 2016 in the office and 2021 at home, when are you using the 365 shown in your profile?