Can an Array formula count unique values and report no. of times for each?

[Father Guido]

Hi,

Is it possible to use an array formula on a range and have it report
the unique values in that range and the number of times each was
encountered?

Barring an array formula solution (preferred) I would entertain a
macro solution.

Thanks,

Norm

XL2002
Windows2000

Eaxample: To get the unique entries in Col A and report then in Col B
and the number of times for each in Col C.

Col A Col B Col C
1 1 1
3 3 1
7 7 1
9 9 3
9 12 1
9 16 1
12 21 2
16 33 1
21 44 1
21 78 7
33 81 1
44 132 1
78 156 1
78
78
78
78
78
78
81
132
156

 

[Guest]

Hi,

Try this: assumes data in column A is ascending order.

Sub GetUniqueNumbers()

Dim iLastRow As Long, NextRow As Long, NextNum As Long
Dim rngB As Range
Dim V As Variant


Set rngB = Range("B1")
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
V = Range("A1:A" & iLastRow + 1)

NextRow = 1
NextNum = V(NextRow, 1)

Do

numcount = NextRow

Do While V(NextRow, 1) = V(NextRow + 1, 1)
NextRow = NextRow + 1
Loop

numcount = NextRow - numcount + 1

rngB = NextNum
rngB.Offset(0, 1) = numcount
Set rngB = rngB.Offset(1, 0)

NextRow = NextRow + 1
NextNum = V(NextRow, 1)

Loop While NextRow < iLastRow

If NextNum <> 0 Then
rngB = NextNum
rngB.Offset(0, 1) = numcount
End If

End Sub

HTH

 

[Guest]

Minor amendment ... sorry.

Sub GetUniqueNumbers()

Dim iLastRow As Long, NextRow As Long, NextNum As Long
Dim rngB As Range
Dim V As Variant

Set rngB = Range("B1")
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
V = Range("A1:A" & iLastRow + 1)

NextRow = 1
NextNum = V(NextRow, 1)
numcount = NextRow

Do

numcount = NextRow

Do While V(NextRow, 1) = V(NextRow + 1, 1)
NextRow = NextRow + 1
Loop

numcount = NextRow - numcount + 1

rngB = NextNum
rngB.Offset(0, 1) = numcount
Set rngB = rngB.Offset(1, 0)

NextRow = NextRow + 1
NextNum = V(NextRow, 1)
numcount = NextRow

Loop While NextRow < iLastRow

If NextNum <> 0 Then
rngB = NextNum
rngB.Offset(0, 1) = NextRow - numcount + 1

End If

End Sub

 

[Father Guido]

On Thu, 19 May 2005 14:07:51 -0700, "Toppers"

~Minor amendment ... sorry.
~
~Sub GetUniqueNumbers()
~
~Dim iLastRow As Long, NextRow As Long, NextNum As Long
~Dim rngB As Range
~Dim V As Variant
~
~Set rngB = Range("B1")
~iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
~V = Range("A1:A" & iLastRow + 1)
~
~NextRow = 1
~NextNum = V(NextRow, 1)
~numcount = NextRow
~
~Do
~
~numcount = NextRow
~
~Do While V(NextRow, 1) = V(NextRow + 1, 1)
~ NextRow = NextRow + 1
~Loop
~
~numcount = NextRow - numcount + 1
~
~rngB = NextNum
~rngB.Offset(0, 1) = numcount
~Set rngB = rngB.Offset(1, 0)
~
~NextRow = NextRow + 1
~NextNum = V(NextRow, 1)
~numcount = NextRow
~
~Loop While NextRow < iLastRow
~
~If NextNum <> 0 Then
~ rngB = NextNum
~ rngB.Offset(0, 1) = NextRow - numcount + 1
~
~End If
~
~End Sub
~

Hey, thanks a lot -- it works like a charm!!!

Norm