Comparing Arrays

[dinosaur_uk]

Good day to you,

I have a problem which is really pissing me off now.

I have two arrays

Array1
Badger
Wombat
Monkey
Dog
Cow

Array2
Cow
Dog
Cat

I want to have a function which takes these two arrays compares them then returns a new array of the difference between the two arrays.

So it would return
Badger
Wombat
Monkey
Cat

Argh!

Help please

[malik641]

I would use Scripting.Dictionary objects for this:

Option Explicit
' Add Reference to Microsoft Scripting Runtime
Public Sub ArrayDifference(ByRef dict1 As Scripting.Dictionary, _
                                ByRef dict2 As Scripting.Dictionary, _
                                ByRef NewDictionary As Scripting.Dictionary)
' Compares the first two dictionary objects passed and creates a new dictionary
' from the difference of the two dictionaries.
' NewDictionary Parameter must be empty when calling this function.
    Dim dict1Key As Variant
    Dim dict2Key As Variant
    
    ' Loop through dict1 to look into dict2's keys
    For Each dict1Key In dict1.Keys
        If Not dict2.Exists(dict1Key) Then
            ' Add to NewDictionary (as long as it doesn't ALREADY
            ' exists in the NewDictionary object)
            If Not NewDictionary.Exists(dict1Key) Then _
                NewDictionary.Add dict1Key, Nothing
        End If
    Next dict1Key
    
    ' Loop through dict2 to look into dict1's keys
    For Each dict2Key In dict2.Keys
        If Not dict1.Exists(dict2Key) Then
            ' Add to NewDictionary (as long as it doesn't ALREADY
            ' exists in the NewDictionary object)
            If Not NewDictionary.Exists(dict2Key) Then _
                NewDictionary.Add dict2Key, Nothing
        End If
    Next dict2Key
End Sub

Public Sub TestMeOut()
    Dim dict1 As Scripting.Dictionary
    Dim dict2 As Scripting.Dictionary
    Dim NewDictionary As Scripting.Dictionary
    
    Dim varShowKeys As Variant
    
    Set dict1 = New Scripting.Dictionary
    Set dict2 = New Scripting.Dictionary
    Set NewDictionary = New Scripting.Dictionary
    
    dict1.Add "Badger", Nothing
    dict1.Add "Wombat", Nothing
    dict1.Add "Monkey", Nothing
    dict1.Add "Dog", Nothing
    dict1.Add "Cow", Nothing
    
    dict2.Add "Cow", Nothing
    dict2.Add "Dog", Nothing
    dict2.Add "Cat", Nothing
    
    Call ArrayDifference(dict1, dict2, NewDictionary)
    
    ' Show results
    For Each varShowKeys In NewDictionary.Keys
        Debug.Print varShowKeys
    Next varShowKeys
End Sub

By the way, I hate using Variant, but I'm not sure how else I would loop through the Dictionary objects in this case.

Good luck!

[dinosaur_uk]

is there any other way besides using scripting?

[malik641]

It would probably take longer. To write and during runtime. I'm not sure at the moment how I would do it using only arrays....hmm...

[malik641]

Yep. More looping involved here.

I know this is probably not the best way to do this, but hey, it worked!

Option Explicit

Public Sub ArrayDifference(ByRef Arr1() As String, _
                           ByRef Arr2() As String, _
                           ByRef NewArr() As String)
' Compares the first two arrays passed and places values
' not found in either array into NewArr()
' from the difference of the two arrays.
' NewArr() Parameter should be empty when calling this procedure.
    Dim i As Long, j As Long, k As Long, m As Long
    Dim blnExists As Boolean, blnInNewArr As Boolean
    
    ReDim NewArr(0)
    
    ' Loop through Arr1 and check in Arr2
    For i = LBound(Arr1()) To UBound(Arr1())
        For j = LBound(Arr2()) To UBound(Arr2())
            If Arr1(i) = Arr2(j) Then
                blnExists = True
                Exit For
            End If
        Next j
        
        ' If not Arr1(i) not found in Arr2 then start
        ' to add to NewArr
        If blnExists = False Then
            ' Check if already exists in NewArr()
            For k = LBound(NewArr()) To UBound(NewArr())
                ' If already exists in NewArr then exit for
                If NewArr(k) = Arr1(i) Then
                    blnInNewArr = True
                    Exit For
                End If
            Next k
            ' If Arr1(i) does not exist in NewArr then add it
            If blnInNewArr = False Then
                ReDim Preserve NewArr(m)
                NewArr(m) = Arr1(i)
                m = m + 1
            End If
        End If
        ' Reset booleans
        blnExists = False
        blnInNewArr = False
    Next i  ' For i = LBound(Arr1()) To UBound(Arr1())
    
    
    ' Now Loop through Arr2 and check in Arr1 (just the reverse of before)
    For i = LBound(Arr2()) To UBound(Arr2())
        For j = LBound(Arr1()) To UBound(Arr1())
            If Arr2(i) = Arr1(j) Then
                blnExists = True
                Exit For
            End If
        Next j
        
        ' If not Arr2(i) not found in Arr1 then start
        ' to add to NewArr
        If blnExists = False Then
            ' Check if already exists in NewArr()
            For k = LBound(NewArr()) To UBound(NewArr())
                ' If already exists in NewArr then exit for
                If NewArr(k) = Arr2(i) Then
                    blnInNewArr = True
                    Exit For
                End If
            Next k
            ' If Arr2(i) does not exist in NewArr then add it
            If blnInNewArr = False Then
                ReDim Preserve NewArr(m)
                NewArr(m) = Arr2(i)
                m = m + 1
            End If
        End If
        ' Reset booleans
        blnExists = False
        blnInNewArr = False
    Next i  ' For i = LBound(Arr2()) To UBound(Arr2())
End Sub

Public Sub TestMeOutAgain()
    
    Dim Arr1(0 To 4) As String
    Dim Arr2(0 To 3) As String
    Dim NewArr() As String
    
    Dim i As Long
    
    Arr1(0) = "Badger"
    Arr1(1) = "Wombat"
    Arr1(2) = "Monkey"
    Arr1(3) = "Dog"
    Arr1(4) = "Cow"
    
    Arr2(0) = "Cow"
    Arr2(1) = "Dog"
    Arr2(2) = "Cat"
    Arr2(3) = "Wow! writing these arrays takes too long lol"
        
    Call ArrayDifference(Arr1(), Arr2(), NewArr())

    ' Show results
    For i = LBound(NewArr()) To UBound(NewArr())
        Debug.Print NewArr(i)
    Next i
End Sub