Herbert,

I'm assuming that you don't know what the unique values are going to be to
start with. So this figures it all out for you. Make sure that the top-left
most cell in your range is selected when you run this. If there is a tie in
the count, the first value is returned. Change the last two
activecell.offset = lines to determine where to place the result set.

Public Sub test()

Dim i As Integer
Dim holder1()
Dim holder2()
Dim bfound As Boolean
Dim intRows As Integer

ReDim holder1(3, 0)
ReDim holder2(3, 0)

Do While ActiveCell.Offset(i, 0) < ""
bfound = False
n = 0

Do Until bfound = True Or n UBound(holder1, 2)
If ActiveCell.Offset(i, 0) = holder1(1, n) And ActiveCell.Offset(i,
1) = holder1(2, n) Then
holder1(3, n) = holder1(3, n) + 1
bfound = True
End If
n = n + 1
Loop

If bfound < True Then
ReDim Preserve holder1(3, UBound(holder1, 2) + 1)
holder1(1, UBound(holder1, 2)) = ActiveCell.Offset(i, 0)
holder1(2, UBound(holder1, 2)) = ActiveCell.Offset(i, 1)
holder1(3, UBound(holder1, 2)) = 1
End If

i = i + 1
Loop

For i = 1 To UBound(holder1, 2)
bfound = False
n = 0
Do Until bfound = True Or n UBound(holder2, 2)
If holder1(1, i) = holder2(1, n) And holder1(3, i) holder2(3, n)
Then
holder2(2, n) = holder1(2, i)
holder2(3, n) = holder1(3, i)
bfound = True
ElseIf holder1(1, i) = holder2(1, n) Then
bfound = True
End If

n = n + 1
Loop

If bfound < True Then
ReDim Preserve holder2(3, UBound(holder2, 2) + 1)
holder2(1, UBound(holder2, 2)) = holder1(1, i)
holder2(2, UBound(holder2, 2)) = holder1(2, i)
holder2(3, UBound(holder2, 2)) = holder1(3, i)
End If

Next i

For i = 1 To UBound(holder2, 2)
ActiveCell.Offset(i - 1, 3) = holder2(1, i)
ActiveCell.Offset(i - 1, 4) = holder2(2, i)
Next i

End Sub
--
Chris Farkas
Excel/Access Developer
<a href="http://www.eAlchemy.biz"www.eAlchemy.biz</a