View Single Post
  #6   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

Forgot to say that the function FindDups will run about twice as fast if it
is compiled to a dll in VB6 with all fast compiler options, so no array
bounds
checking etc.

RBS


"RB Smissaert" wrote in message
...
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.