Function to count distinct values in a column range

Question

I am attempting to create a function in VBA that, when given a range of values, will return a Count Distinct of those values. For example:

| Column A | |----------| | 1 | | 2 | | 3 | | 3 | | 3 | | 3 | | 4 | | 4 | | 5 | | 5 | | 6 | Count of Rows = 11 Distinct values = 6

Here is the structure of the VBA code I'm trying to use to build a function I can call in Excel:

Function CountDistinct(dataRange As Range)

Dim x As Double
x = 0

For i = 1 To dataRange.Rows.Count

x = x + (1 / (CountIf(dataRange, dataRange(i))))

Next i

End Function

I'm completely new to VBA programming, so apologies for all of the obvious, glaring mistakes made in the code above, if it can even be called that.

I know there are other ways to arrive at the correct answer, but I'm interested in learning how to create custom Excel functions.

Also, the pseudo-logic behind my approach is as follows:

Give the function CountDistinct a range of cells dataRange
Loop through the range
For each cell in the range, perform a COUNTIF on that value across the range (so in the example above, rows 3-6 would each return 4, since the number 3 appears 4 times in the range).
For each cell in the range, add 1/(the result of step 3) to the result variable x

| Values | CountIF(Value) | 1/CountIF(Value) | |--------|----------------|-----------------------------| | 1 | 1 | 1 | | 2 | 1 | 1 | | 3 | 4 | 0.25 | | 3 | 4 | 0.25 | | 3 | 4 | 0.25 | | 3 | 4 | 0.25 | | 4 | 2 | 0.5 | | 4 | 2 | 0.5 | | 5 | 2 | 0.5 | | 5 | 2 | 0.5 | | 6 | 1 | 1 | | | | SUM of 1/CountIF(Value) = 6 |

This will return the Count of Distinct values in column A == 6.

You can use a function to find the number of unique values: office.microsoft.com/en-us/excel-help/… — Chrismas007
– Chrismas007, Commented Nov 17, 2014 at 20:07

SeanC · Accepted Answer · 2014-11-17 20:16:37Z

4

First Steps:
Add Option Explicit to the header of all your modules. It will capture the difference between OneVariable and OneVarlable.
Make your variables meaningful - will you know what x and i were for next time you look at this code?

Your options for the count are

user the worksheet function
save the values, and only count those that don't match previous values

Using the worksheet function,

Option Explicit

Function CountUnique(dataRange As Range) As Long
Dim CheckCell
Dim Counter As Double
Counter = 0

For Each CheckCell In dataRange.Cells
    Counter = Counter + (1 / (WorksheetFunction.CountIf(dataRange, CheckCell.Value)))
Next
' Finally, set your function name equal to the Counter, 
'   so it knows what to return to Excel
CountUnique = Counter
End Function

Using the keeping track

...
' check out scripting dictionaries
' much more advanced - Keep it simple for now
...

answered Nov 17, 2014 at 20:16

SeanC

16k5 gold badges48 silver badges67 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

user1408914 Over a year ago

Thanks so much - the solution works well. The clear explanations were also greatly appreciated.

Jaragoth · Accepted Answer · 2016-12-16 23:15:48Z

Way late to the party, but I thought I would put in another VBA option that does not require adding a reference.

In addition this touches on a neat function of excel VBA that I wish I had learn much earlier.

My solution to this uses the Collection object in order to find distinct values.

Option Explicit
'^ As SeanC said, adding Option Explicit is a great way to prevent writing errors when starting out.
Public Function CountDistinct(r As Range) As Long
'' DIM = declare in memory

Dim col As Collection
Dim arr As Variant
Dim x As Long
Dim y As Long

Set col = New Collection
'' setting a Variant = Range will fill the Variant with a 2 dimensional array of the values of the range!
arr = r
'' skip the errors that are raised
On Error Resume Next
'' loop over all of the elements.
'' UBound is a built in VBA Function that gives you the largest value of an array.
    For x = 1 To UBound(arr, 1)
        For y = 1 To UBound(arr, 2)
            '' try to add the value in arr to the collection
            col.Add 0, CStr(arr(x, y))

            '' every time the collection runs into a value it has already added,
            '' it will raise an error.
            'uncomment the below to see why we are turning off errors
            'Debug.Print Err.Number, Err.Description

        Next
    Next
'' turn errors back on.
On Error GoTo 0
''set the function name to the value you want the formula to return
CountDistinct = col.Count
'' The next parts should be handled by VBA automatically but it is good practise to explicitly clean up.
Set col = Nothing
Set arr = Nothing
Set r = Nothing
End Function

I hope this helps someone down the line.

Ben1344 · Accepted Answer · 2014-11-17 20:19:28Z

1

There are (of course) other ways this could be done with VBA.

Public Function CountDistinct(rng As Range) As Long
  Dim i As Long
  Dim Cnt As Double
  Cnt = 0
  For i = 1 To rng.Rows.Count
    Cnt = Cnt + 1 / WorksheetFunction.CountIf(rng, rng(i, 1))
  Next i
  CountDistinct = CLng(Cnt)
End Function

answered Nov 17, 2014 at 20:19

Ben1344

444 bronze badges

Comments

Chrismas007 · Accepted Answer · 2014-11-17 20:15:13Z

0

Sub CountDistinct()
    Dim RunSub As Long
    Dim LastRow As Long
    Dim CurRow As Long
    Dim Unique As Long

        LastRow = Range("A" & Rows.Count).End(xlUp).Row
        Unique = 1

        For CurRow = 2 To LastRow
            If Range("A2:A" & CurRow - 1).Find(Range("A" & CurRow, LookIn:=xlValues)) Is Nothing Then
            Unique = Unique + 1
            Else
            End If
        Next CurRow

        MsgBox Unique & " Unique Values"

End Sub

answered Nov 17, 2014 at 20:15

Chrismas007

6,1154 gold badges27 silver badges47 bronze badges

Comments

tbur · Accepted Answer · 2014-11-17 20:55:49Z

0

I'll chime in here as well...

Public Function Count_Distinct_In_Column(Rng As Range)
    Count_Distinct_In_Column = _
    Evaluate("Sum(N(countif(offset(" & Rng.Cells(1).Address _
    & ",,,row(" & Rng.Address & "))," & Rng.Address & ")=1))")
End Function

Called like:

 ? Count_Distinct_In_Column(Range("A2:A12"))

6

answered Nov 17, 2014 at 20:55

tbur

2,4941 gold badge16 silver badges12 bronze badges

Comments

bilbo_strikes_back · Accepted Answer · 2014-11-17 21:40:48Z

This method applies the following logic.

Place the range elements into an array
Place the array into a dictionary for unique elements only
Count the elements (keys) in the dictionary for unique elements

Under Tools-->References, Reference "Microsoft Scripting Runtime"

Option Explicit

Dim lngCounter As Long
Dim dataRange As Range
Dim dictTemp As Dictionary
Dim varTemp As Variant

Sub Test()

Set dataRange = Range(Cells(2, 1), Cells(12, 1))

MsgBox CountDistinct(dataRange), vbInformation + vbSystemModal, "Count Distinct"

End Sub

Public Function CountDistinct(dataRange As Range) As Long

'Populate range into array
If dataRange.Rows.Count < 2 Then
    ReDim varTemp(1 To 1, 1 To 1)
    varTemp(1, 1) = dataRange
Else
    varTemp = dataRange
End If

'Dictionaries can be used to store unique keys into memory
Set dictTemp = New Dictionary

'Add array items into dictionary if they do not exist
For lngCounter = LBound(varTemp) To UBound(varTemp)
    If dictTemp.Exists(varTemp(lngCounter, 1)) = False Then
        dictTemp.Add Key:=varTemp(lngCounter, 1), Item:=1
    End If
Next lngCounter

'Count of unique items in dictionary
CountDistinct = dictTemp.Count

End Function

pnuts · Accepted Answer · 2014-11-18 00:38:51Z

0

In Excel 2013, use Distinct Count in a PivotTable.

answered Nov 18, 2014 at 0:38

pnuts

59.8k11 gold badges93 silver badges141 bronze badges

Comments

AnalysHass · Accepted Answer · 2024-01-18 00:42:26Z

0

I normally use the simple Excel formula

= sum ( 1 / countif (range, range) )

Is there not a way to turn that approach into a custom function using VBA?

I imagine you might have to break this into two steps: (1) generate the array then (2) do the sum. But it's still quite simple compared with some of the suggested solutions here.

answered Jan 18, 2024 at 0:42

AnalysHass

11 bronze badge

Collectives™ on Stack Overflow

Function to count distinct values in a column range

8 Answers 8

1 Comment

1 Comment

Comments

Comments

Comments

Comments

Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

8 Answers 8

1 Comment

1 Comment

Comments

Comments

Comments

Comments

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related