VBA application specific error

Question

I am trying to iterate over a series of numbers (Col A). Many of the numbers are duplicates, and I'm going to indicate how many times each number appears in column F in the row corresponding to the original number. However, I continue to get the error set by the application until my "End" 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 greatly appreciated.

Answer 1

Use a collection object if you need a list of unique elements. In this case, you want to calculate how many times something is duplicated, so in our error detection procedure we get the current number of duplicates, add 1 to it, then drop the item from the collection and add it again with a new counter.

 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