G
gtslabs
I am using code from here: 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
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