Compare List - Get Duplicate Values

[John Mansfield]

I've used a variation of the following code to extract
unique items from two lists. Now, instead of capturing
the unique values going in to the collection, I would like
to capture everything that is not accepted into the
collection and put those values into a list. I've tried
to do this by adding error handling code without luck.
How could I rewrite this to capture all items not accepted
into the collection? Thanks.

Sub ListDuplicateVal()

Dim Rng1 As Range
Dim Rng2 As Range
Dim Cell As Range
Dim UniqueValues As New Collection

Set Rng1 = Range("B4:C10")
Set Rng2 = Range("E4")

On Error GoTo ErrorTrap
For Each Cell In Rng1
UniqueValues.Add Cell.Value, CStr(Cell.Value)
ErrorTrap:
Select Case Err
Case 457
Rng2.Value = Rng1.Value
Set Rng2 = Rng2.Offset(1, 0)
End Select

Next Cell

End Sub

 

[Tom Ogilvy]

Sub ListDuplicateVal()

Dim Rng1 As Range
Dim Rng2 As Range
Dim Cell As Range
Dim UniqueValues As New Collection

Set Rng1 = Range("B4:C10")
Set Rng2 = Range("E4")
On Error Resume Next
For Each Cell In Rng1
UniqueValues.Add Cell.Value, CStr(Cell.Value)

Select Case Err
Case 457
Rng2.Value = Cell.Value
Set Rng2 = Rng2.Offset(1, 0)
End Select
Err.Clear
Next Cell
End Sub

 

[John Mansfield]

Thank you Tom. I appreciate your help.

-----Original Message-----
Sub ListDuplicateVal()

Dim Rng1 As Range
Dim Rng2 As Range
Dim Cell As Range
Dim UniqueValues As New Collection

Set Rng1 = Range("B4:C10")
Set Rng2 = Range("E4")
On Error Resume Next
For Each Cell In Rng1
UniqueValues.Add Cell.Value, CStr(Cell.Value)

Select Case Err
Case 457
Rng2.Value = Cell.Value
Set Rng2 = Rng2.Offset(1, 0)
End Select
Err.Clear
Next Cell
End Sub

--
Regards,
Tom Ogilvy




.