View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
RB Smissaert RB Smissaert is offline
external usenet poster
 
Posts: 2,452
Default Create list of duplicated numbers

This works with the free dll dhRichClient3 from Olaf Schmidt
www.datenhaus.de/Downloads/dhRichClient3.zip
and will be very fast:


Function FindDups(arr1 As Variant, _
arr2 As Variant, _
Optional bUniqueDuplicatesOnly As Boolean) As Variant

'will take 2 1-based, 2-D, 1-column arrays
'and produce a 1-based, 2-D, 1-column array
'with the duplicates that are in the first 2 arrays
'optionally get unique duplicates only
'--------------------------------------------------
Dim i As Long
Dim n As Long
Dim cCol1 As cCollection
Dim colDup As cCollection
Dim arrDup

Set cCol1 = New cCollection
Set colDup = New cCollection

cCol1.CompatibleToVBCollection = False
cCol1.UniqueKeys = True

colDup.CompatibleToVBCollection = False
colDup.UniqueKeys = bUniqueDuplicatesOnly

'add arr1 to cCol1
For i = 1 To UBound(arr1)
If cCol1.Exists(arr1(i, 1)) = False Then
n = n + 1
cCol1.Add n, arr1(i, 1)
End If
Next i

'add the duplicates to colDup
If bUniqueDuplicatesOnly Then
For i = 1 To UBound(arr2)
If cCol1.Exists(arr2(i, 1)) Then
If colDup.Exists(arr2(i, 1)) = False Then
colDup.Add arr2(i, 1), arr2(i, 1)
End If
End If
Next i
Else
For i = 1 To UBound(arr2)
If cCol1.Exists(arr2(i, 1)) Then
colDup.Add arr2(i, 1)
End If
Next i
End If

If colDup.Count = 0 Then
FindDups = arrDup
Exit Function
End If

'transfer colDup to an array
ReDim arrDup(1 To colDup.Count, 1 To 1)

For i = 1 To colDup.Count
arrDup(i, 1) = colDup.ItemByIndex(i - 1)
Next i

FindDups = arrDup

End Function


Sub test()

Dim arr1
Dim arr2
Dim arrDup

arr1 = Range(Cells(1), Cells(65535, 1))
arr2 = Range(Cells(3), Cells(65535, 3))

arrDup = FindDups(arr1, arr2, True)

Range(Cells(5), Cells(UBound(arrDup), 5)) = arrDup

End Sub


You could do the same with the standard VB collection, but that will be
slower.
The above FindDup can run in less than a second, depending on the data in
the ranges.


RBS


"J.W. Aldridge" wrote in message
...
I have a string of data (numbers) starting in B6:B10000 and another
in
I6:I10000..

I need a code to search both strings and return any numbers that
appeared in both list. This list of duplicated numbers should start in
S6.