Eliminate Duplicates in Arrays

[cstimart]

Suppose I have 2 Arrays: Example1(1 to 20) and Example2(1 to 35)

Is there a quick an easy was to compare these two and remove any records that are in BOTH of the arrays?

Also, the "20" and "35" will vary each time the macro is executed.

 

[PietBom]

I used VBA with the Collection feature.
A Collection can only contain unique strings

http://www.mijnbestand.nl/Bestand-RNFCQBBMVUQ3.xls

 

[cstimart]

Thanks....I'll check it out.

 

[cstimart]

I used VBA with the Collection feature.
A Collection can only contain unique strings

http://www.mijnbestand.nl/Bestand-RNFCQBBMVUQ3.xls

I took a look at this and it only eliminates duplicates (which helps me with another project)...what I need to happen is that when there are duplicates, ALL of the duplicates are removed.

 

[trunten]

do you mean like this?

Sub test()
    Dim a(), b(), c(), d, e, i
    a = Application.Transpose(Evaluate("Row(1:20)"))
    b = Application.Transpose(Evaluate("Row(10:40)"))
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To Application.Max(UBound(a), UBound(b))
        If i <= UBound(a) Then d(a(i)) = d(a(i)) + 1
        If i <= UBound(b) Then d(b(i)) = d(b(i)) + 1
    Next i
    For Each e In d
        If d(e) > 1 Then d.Remove e
    Next e
    c = Array(d.keys) '<-No dupicates!
    'c = Application.Transpose(Application.Transpose(Array(d.keys))) 'for 1d
End Sub

 

[cstimart]

do you mean like this?

Sub test()
    Dim a(), b(), c(), d, e, i
    a = Application.Transpose(Evaluate("Row(1:20)"))
    b = Application.Transpose(Evaluate("Row(10:40)"))
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To Application.Max(UBound(a), UBound(b))
        If i <= UBound(a) Then d(a(i)) = d(a(i)) + 1
        If i <= UBound(b) Then d(b(i)) = d(b(i)) + 1
    Next i
    For Each e In d
        If d(e) > 1 Then d.Remove e
    Next e
    c = Array(d.keys) '<-No dupicates!
    'c = Application.Transpose(Application.Transpose(Array(d.keys))) 'for 1d
End Sub

That's a little above my weight class.

 

[trunten]

Ok, sorry. Here it is again with comments. hth

Option Explicit

Sub test()
    Dim a(), b(), c(), d, e, i
    'Create an array with numbers 1 to 20 for test purposes. Assign to a
    a = Application.Transpose(Evaluate("Row(1:20)"))
    'Create an array with numbers 10 to 40 for test purposes. Assign to b
    b = Application.Transpose(Evaluate("Row(10:40)"))
    
    'This is the important bit!
    '''''''''''''''''''''''''''''
    'Create a new dictionary object.
    'Dictionaries hold key value pairs so I can count instances of a value
    Set d = CreateObject("Scripting.Dictionary")
    'Loop through both my arrays adding to the dictionary as I go
    For i = 1 To Application.Max(UBound(a), UBound(b))
        'next two lines are the same but with the array i'm referencing changed
        'Logic: if i is still within the bounds of the array (I could've used
        'two separate loops but I'm lazy) then fetch the value already associated
        'with the key a(i)/b(i)  (it will be created if it doen't exist yet).
        'Add 1 to that value, then store the new value back in the dictionary.
        If i <= UBound(a) Then d(a(i)) = d(a(i)) + 1
        If i <= UBound(b) Then d(b(i)) = d(b(i)) + 1
    Next i
    'Now all the values are in the dictionary along with how many times they appeared
    'in either array we can remove the values that were found more than once.
    'Loop through each element in the dictionary objects "keys" (ie. the array values)
    For Each e In d
        'If the value associated with that key is more than 1 then it is a duplicate
        'and can therefore be removed.
        If d(e) > 1 Then d.Remove e
    Next e
    'Finally assign the remaining keys to a new array. This array will contain only number
    'that were not duplicated across the two arrays
    c = Array(d.keys) '<-No dupicates!
    
    'The array produced will be a zero based two dimensional array. If you want just a
    '1 dimensional array then delete the line above and uncomment the line below.
    'c = Application.Transpose(Application.Transpose(Array(d.keys))) 'for 1d
End Sub

 

[taurean]

Is this useful?

Sub UniqueArray()
Dim a(), b(), c(), iCount As Long
'Two Arrays
a = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20)
b = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, _
21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35)

'Here we load up the third one from first 2
For i = LBound(b) To UBound(b)
    If Not IsNumeric(Application.Match(b(i), a, 0)) Then
    ReDim Preserve c(iCount)
    c(iCount) = b(i)
    iCount = iCount + 1
    End If
Next i

'Printing the list
MsgBox "Total Items Found :" & (UBound(c) + 1) & ". They Are:" & vbCrLf & Join(c, vbCrLf)
End Sub

 

[PietBom]

I took a look at this and it only eliminates duplicates (which helps me with another project)...what I need to happen is that when there are duplicates, ALL of the duplicates are removed.

The original arrays contained duplicates and also in the combination of the 2 arrays have duplicates.
Ik did not remove the duplicates from the original arrays.
When you click the button: Merge.... you will see the result of the merged arrays in column C without duplicates.
Did you click the button ?

 

[trunten]

ReDim preserve in a loop? I always thought that was evil.