Search code examples
excelvbamultidimensional-arrayarray-difference

Difference between two 2D arrays in VBA


I am trying to get the difference between two arrays in excel VBA.

I found a solution to what I am trying to achieve here: Solution

But it seems to work only with 1D arrays.

Here you have a sample of what I am trying to achieve: enter image description here

I have tried to modify the code I found and use Jagged Arrays but it didn't work out. I got error 13 type mismatch on this line: coll.Add arr1(i, j), arr1(i, j)

this is how my code looks like now:

        Sub Test()

Dim arr1 As Variant
Dim arr2 As Variant
Dim arr3 As Variant
Dim coll As Collection
Dim i As Long, j As Long

With Worksheets("Sheet2")
    LastRowColumnA = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr1 = .Range("A1:C" & LastRowColumnA).Value
End With

With Worksheets("Sheet1")
    LastRowColumnA = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr2 = .Range("A1:C" & LastRowColumnA).Value
End With
Set coll = New Collection
For i = LBound(arr1, 1) To UBound(arr1, 1)
    For j = LBound(arr1, 2) To UBound(arr1, 2)
        coll.Add arr1(i, j), arr1(i, j)
    Next j
Next i

For i = LBound(arr2, 1) To UBound(arr2, 1)
    For j = LBound(arr2, 2) To UBound(arr2, 2)
        On Error Resume Next
        coll.Add arr2(i, j), arr2(i, j)
        If Err.Number <> 0 Then
            coll.Remove arr2(i, j)
        End If
        On Error GoTo 0
   Next j
Next i

ReDim arr3(1 To coll.Count, 1 To 1)

For i = 1 To coll.Count
    arr3(i, 1) = coll(i)
    Debug.Print arr3(i, 1)
Next i

Worksheets("Sheet2").Range("F1").Resize(UBound(arr3, 1), 1).Value = arr3
End Sub

Anyone know how it could be solved?


Solution

  • So here we have the solution:

    Sub test()
    
    Dim arr1 As Variant
    Dim arr2 As Variant
    Dim arr3 As Variant
    Dim coll As Collection
    Dim i As Long, j As Long, ii As Long, txt As String, x
    
    With Worksheets("Sheet2")
        LastRowColumnA = .Cells(.Rows.Count, 1).End(xlUp).Row
        arr1 = .Range("A1:C" & LastRowColumnA).Value
    End With
    
    With Worksheets("Sheet1")
        LastRowColumnA = .Cells(.Rows.Count, 1).End(xlUp).Row
        arr2 = .Range("A1:C" & LastRowColumnA).Value
    End With
    Set coll = New Collection
    On Error Resume Next
    For i = LBound(arr1, 1) To UBound(arr1, 1)
        txt = Join(Array(arr1(i, 1), arr1(i, 2), arr1(i, 3)), Chr(2))
        coll.Add txt, txt
    Next i
    
    For i = LBound(arr2, 1) To UBound(arr2, 1)
        txt = Join(Array(arr2(i, 1), arr2(i, 2), arr2(i, 3)), Chr(2))
        Err.Clear
        coll.Add txt, txt
        If Err.Number <> 0 Then coll.Remove txt
    Next i
    
    ReDim arr3(1 To coll.Count, 1 To 3)
    
    For i = 1 To coll.Count
        x = Split(coll(i), Chr(2))
        For ii = 0 To 2
            arr3(i, ii + 1) = x(ii)
        Next
    Next i
    
    Worksheets("Sheet2").Range("F1").Resize(UBound(arr3, 1), 3).Value = arr3
    End Sub