I do have duplicate rows and that function worked great. Thanks for the
help.

- David
Tom Ogilvy wrote:
Try it this way

Dim v as Variant
ReDim data(1 To nodupes.Count, 1 To 4)
v = ActiveSheet.Cells(1,1).Resize(669,5).Value
On Error Resume Next
For Each Item In nodupes
f = f + 1
For c = 1 To 669
If v(c, 1) = Item Then
If v(c,3) = "Adult" Then
d = d + 1
ElseIf v(c, 3) = "Student" Then
s = s + 1
End If
data(f, 4) = v(c, 5)
End If
Next 'C

data(f, 1) = Item
data(f, 2) = d
data(f, 3) = s
d = 0
s = 0
Next 'Item
ListBox1.List = data

I removed the Exit For since it sounds like you have duplicate rows in the
sheet that match the value of item. If that isn't the case, put it back in.

--
Regards,
Tom Ogilvy