VBA Application Defined Error

Question

I'm trying to iterate through a row of numbers (Col A). Many of the numbers are duplicates, and I'm going to put how many times each number appears in Column F in a row corresponding to the original number. However, I keep getting a Application Defined Error before my End If code.

Sub Iterate()

    Range("A65536").End(xlUp).Select
    Dim iVal As Long
    Dim duplicate As Long
    duplicate = Cells(2, 1).Value
    For i = 3 To Range("A" & Rows.Count).End(xlUp).Row
        If ActiveCell(i, 1).Value <> duplicate Then
            iVal = Application.WorksheetFunction.CountIf(Range("A1:A"), ActiveCell(i, 1).Value)
            duplicate = iVal
        End If
            iVal = duplicate
            Cells(i, 6).Value = iVal
    Next
End Sub

Any help would be much appreciated.

Answer 1

Use a collection object when you want a list of unique items. In this case, you want to count how many times something is duplicated, so in our error catching routine we get the current number of duplicates, add 1 to it, then drop the item from the collection and re-add it with the new count.

Dim i As Integer
Dim myCol As New Collection
Dim IncrementedValue As Integer

'Because you start on row 3, we have to add 2 to the row count
For i = 3 To Sheet1.UsedRange.Rows.Count + 2
    On Error GoTo DupFound
    myCol.Add 1, Sheet1.Cells(i, 1).Text
    On Error GoTo 0
Next

'Because you start on row 3, we have to add 2 to the row count
For i = 3 To Sheet1.UsedRange.Rows.Count + 2
    Sheet1.Cells(i, 6).Value = myCol.Item(Sheet1.Cells(i, 1).Text)
Next
Exit Sub

DupFound:
IncrementedValue = myCol.Item(Sheet1.Cells(i, 1).Text) + 1
myCol.Remove Sheet1.Cells(i, 1).Text
myCol.Add IncrementedValue, Sheet1.Cells(i, 1).Text
Resume Next