Comparing Arrays

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:eek:

I would use Scripting.Dictionary objects for this:

Code:

---

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!

is there any other way besides using scripting?

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...

Yep. More looping involved here.

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

Code:

---

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

---