Count Distinct Values and ignore blanks

[Anthony86]

Hi Guys me again,

I'm trying to count column M:M for distinct values and something that doesn't take all day to get the result back. I did use this formula, but it plays upon large amounts of data.

=SUMPRODUCT((Data!M2:M6177<>"")/COUNTIF(Data!M2:M6177,Data!M2:M6177&""))

Is there a code that will do this in VBA and at an ok speed and put the result in sheet2 B2?

I found this code after alot of searching and it counts everything as well as blanks!

Sub CntUnique()
Dim Uni As Collection, cl As Range, LpRange As Range
Dim clswfrm As Range, clswcst As Range, myRng As Range
Dim TotUni As Long
'*************
Set myRng = Sheets(2).[M:M] 'define your sheet/range
'*************
On Error Resume Next
Set clswfrm = myRng.SpecialCells(xlFormulas)
Set clswcst = myRng.SpecialCells(xlConstants)
Set myRng = Nothing 'free up memory
On Error GoTo 0
If clswfrm Is Nothing And clswcst Is Nothing Then
MsgBox "No Unique Cells"
Exit Sub
ElseIf Not clswfrm Is Nothing And Not clswcst Is Nothing Then
Set LpRange = Union(clswcst, clswfrm)
ElseIf clswfrm Is Nothing Then Set LpRange = clswcst
Else: Set LpRange = clswfrm
End If
Set clswfrm = Nothing: Set clswcst = Nothing 'Free up memory
Set Uni = New Collection
On Error Resume Next
For Each cl In LpRange
Uni.Add cl.Value, CStr(cl.Value) 'assign unique key string
Next cl
On Error GoTo 0
Set LpRange = Nothing 'free up memory
TotUni = Uni.count
Set Uni = Nothing ''free up memory
MsgBox TotUni 'Work with the Unique value total here (replace msgbox)
End Sub

 

[Fluff]

Is this what you want

Sub countUnique()
Dim cl As Range
With CreateObject("scripting.dictionary")
   For Each cl In Sheets("Data").Range("M2", Sheets("Data").Range("M" & Rows.Count).End(xlUp))
      If Not .Exists(cl.Value) And Not cl.Value = "" Then .Add cl.Value, Nothing
   Next cl
   Sheets("sheet2").Range("B2").Value = .Count
End With
   
End Sub

 

[Aladin Akyurek]

Control+shift+enter, not just enter:

=SUM(IF(FREQUENCY(IF(Data!M2:M6177<>"",MATCH(Data!M2:M6177,Data!M2:M6177,0)),ROW(Data!M2:M6177)-ROW(

Data!M2)+1),1))

If

Data!M2:M6177 consists solely of numbers, just enter:

=

SUM(IF(FREQUENCY(Data!M2:M6177,

Data!M2:M6177),1))​

​

_{^{<strike>
</strike>}}​

​

​

<strike></strike>

​

 

[Anthony86]

Is this what you want

Sub countUnique()
Dim cl As Range
With CreateObject("scripting.dictionary")
   For Each cl In Sheets("Data").Range("M2", Sheets("Data").Range("M" & Rows.Count).End(xlUp))
      If Not .Exists(cl.Value) And Not cl.Value = "" Then .Add cl.Value, Nothing
   Next cl
   Sheets("sheet2").Range("B2").Value = .Count
End With
   
End Sub

This works a charm, thanks very much!

 

[Fluff]

You're welcome