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

1. Give the function CountDistinct a range of cells dataRange
2. Loop through the range
3. 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).
4. 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.

Answer 1

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

1. user the worksheet function
2. 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
...