Hi Tom,

Apologies, no need for my amendment to

ElseIf ar.Count = 5 Then
cnt1 = cnt1 + 2

I should have used your first version of the code and not the version headed
up "this matches your results".

Cheers,
Sam

Tom Ogilvy wrote:
Sub CountData()
Dim rng As Range, rng1 As Range
Dim cnt As Range, cell As Range
Dim cell1 As Range, cnt1 As Long
Set rng = Range("Data")
Set rng1 = Range(Cells(2, 1), Cells(2, 1).End(xlDown))
For Each cell In rng1
Set rng2 = Nothing
For Each cell1 In rng
If cell1 = cell Then
If rng2 Is Nothing Then
Set rng2 = Cells(cell1.Row, 1)
Else
Set rng2 = Union(rng2, Cells(cell1.Row, 1))
End If
End If
Next
cnt1 = 0
For Each ar In rng2.Areas
If ar.Count = 2 Then
cnt1 = cnt1 + 1
End If
Next
cell.Offset(0, 1).Value = cnt1
Next
End Sub

Produces results matching yours except for 129.

29 is correct per your VBA code. My count was incorrect.

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200702/1