Try counting after creating the NoDupes list - see the macro below.

HTH,
Bernie
MS Excel MVP


Private Sub GetDuplicateCount2()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim item As Variant
Dim i As Integer, j As Integer
Dim myC As Range

Set AllCells = Worksheets("Data").AutoFilter.Range.Columns(18)

On Error Resume Next
For Each Cell In AllCells.SpecialCells(xlVisible)
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method must be a string
Next Cell
' Resume normal error handling
On Error GoTo 0

' Add the unique items to a the Sheet
j = 1
For Each item In NoDupes
Worksheets("Input").Cells(j, 13).Value = item
j = j + 1
Next item

'Count the occurences of the visible items
For Each Cell In AllCells.SpecialCells(xlVisible)
Set myC = Worksheets("Input").Cells(1, 13).EntireColumn.Find(Cell.Value)
myC.Offset(0, 1).Value = myC.Offset(0, 1).Value + 1
Next Cell

End Sub

"gtslabs" wrote in message
...
I am using code from he http://www.j-walk.com/ss/excel/tips/tip47.htm
to get a list of unique strings from an autofiltered range.
I can get the list ok but I need help getting a count of each
occurance.
I dont want a PivotTable, I need the code.
I tried the worksheet formula countif but it looked at all the rows
not the just the filtered one.
Please advise.


Private Sub GetDuplicateCount()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer

Set AllCells = Worksheets("Data").AutoFilter.Range.Columns(18)

On Error Resume Next
For Each Cell In AllCells.SpecialCells(xlVisible)
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method must be a
string
Next Cell
' Resume normal error handling
On Error GoTo 0


' Add the unique items to a the Sheet
j = 1
For Each Item In NoDupes
Worksheets("Input").Cells(j, 13).Value = Item
' Worksheets("Input").Cells(j, 14).Value = itemcount 'Need help
with this.
j = j + 1
Next Item

End Sub