Hi

If I have understood how you want to count things, then this should give you the count. Assume that the data is a,a,b,b then the output you would want is 2 (ie there are 2 duplicate names). Similarly if the data is a,a,b,b,b then the result is 3.

Tony

Sub aaa()

Dim nodupes As New Collection
countall = 0
Range("a3").Select
On Error Resume Next
While Not IsEmpty(ActiveCell)
nodupes.Add ActiveCell.Value, CStr(ActiveCell.Value)
countall = countall + 1
ActiveCell.Offset(1, 0).Select
Wend
On Error GoTo 0

Range("D3").Value = countall - nodupes.Count

End Sub