Pages

22.12.11

Count Unique Values in a Range of Cells

I'm not sure why I wrote this function... I'm sure there are easier and more useful ways to do this... but at the time I remember it accomplished its mission so, for what it's worth...

'This macro counts the number of unique values in a range and

'displays a message with the result

'Copyright, Andrés González, 2008

Sub contarunicos()

Dim matriz()

SizeRango = Selection.Count

ReDim matriz(SizeRango)

'matriz(pos) = rango(pos, 1)

ocurrencia = 0

celdas = 0

ultima = 1

For Each celda In Selection

For cont = 1 To ultima

If celda.Value = matriz(cont) Then

ocurrencia = "si"

Else

garbage = 1

End If

Next cont

If ocurrencia = "si" Then

ultima = ultima

Else

matriz(ultima) = celda.Value

ultima = ultima + 1

End If

ocurrencia = 0

Next

MsgBox ("There are " & ultima - 1 & " unique values")

End Sub

No comments:

Post a Comment