Collection from Range, tag cells on error

[nowon]

Hello,
I am using a standard piece of code taken from this newgroup to get a unique
collection of items taken from a range.

Dim AllCells As Range, Cell As Range

Dim NoDupes As New Collection

Lstcll = Application.WorksheetFunction.CountA(ActiveSheet.Range("A:A"))

Set AllCells = ActiveSheet.Range("A2:A" & Lstcll)

On Error Resume Next

For Each Cell In AllCells

NoDupes.Add Cell.Value, CStr(Cell.Value)

Next Cell

I understand the premise of using this because Excel generates an error when
trying to add a duplicate to the collection and will not add it. But how
can i make Excel write something like "if is error(NoDupes.Add Cell.value)
then
Cell.offset(0,9).value = "Delete Me"

Thank you.

 

[Dave Peterson]

One way:

Option Explicit
Sub testme()
Dim AllCells As Range
Dim Cell As Range
Dim NoDupes As Collection
Dim LstCll As Long

Set NoDupes = New Collection

LstCll = Application.WorksheetFunction.CountA(ActiveSheet.Range("A:A"))

Set AllCells = ActiveSheet.Range("A2:A" & LstCll)

On Error Resume Next
For Each Cell In AllCells.Cells
NoDupes.Add Cell.Value, CStr(Cell.Value)
If Err.Number <> 0 Then
Cell.Offset(0, 1).Value = "Delete me"
Err.Clear
End If
Next Cell
On Error GoTo 0

End Sub