Compare two arrays and add matching strings to another array

Question

So I have two arrays. One of them is 1D (AllAssigneesUnique) and the other is 2D (DB_Array). I want to compare (AllAssigneesUnique) with the first column of (DB_Array) and when there is an exact match, store the string from the first and second column of (DB_Array) to a third 3D Array called (NewAssigneesArray). Additionally, the third column of (NewAssigneesArray) should have the string "New". Below is my code so far. P.S. How can I re-dimension the new array automatically since the number of matching strings will not always be the same? At the moment, I am using a previously made dictionary to get the exact number of matching strings.

Dim NewAssigneesArray() As Variant
ReDim NewAssigneesArray(1 To NewAssigneesList.count, 1 To 3)


For a = LBound(AllAssigneesUnique) To UBound(AllAssigneesUnique)
    For b = LBound(DB_Array, 1) To UBound(DB_Array, 1)
        If AllAssigneesUnique(a) = DB_Array(b, 1) Then
            For i = LBound(NewAssigneesArray) To UBound(NewAssigneesArray)
                NewAssigneesArray(i, 1) = DB_Array(b, 1)
                NewAssigneesArray(i, 2) = DB_Array(b, 2)
                NewAssigneesArray(i, 3) = "New"
            Next i
        End If
    Next b
Next a

score 1 · Accepted Answer · answered Feb 14 '20 at 09:44

The code below is untested for obvious reasons and might contain typos or small errors. I believe you will be able to correct them. Note that it's more efficient to dimension an array larger than required and give it its final size at the end. The large UBound doesn't require RAM space.

Sub CreateNewArray()

    Dim NewAssigneesArray() As Variant
    Dim i As Long
    Dim a As Long, b As Long

    ' set a (UBound, 2) a lot higher than what you will ever need.
    ' note that you can't Redim (UBound, 1), only (UBound, 2)
    ReDim NewAssigneesArray(1 To 3, 1 To 5000)

    For a = LBound(AllAssigneesUnique) To UBound(AllAssigneesUnique)
        For b = LBound(DB_Array, 1) To UBound(DB_Array, 1)
            ' Use VbBinaryCompare for a case sensitive comparison
            If StrComp(AllAssigneesUnique(a), DB_Array(b, 1), vbTextCompare) = 0 Then
                i = i + 1
                NewAssigneesArray(1, i) = DB_Array(b, 1)
                NewAssigneesArray(2, i) = DB_Array(b, 2)
                NewAssigneesArray(3, i) = "New"
                Exit For
            End If
        Next b
    Next a
    ReDim Preserve NewAssigneesArray(1 To 3, 1 To i)
End Sub

FYI You might be interested in my work around to `ReDim Preserve` allowing restructuring the array's first dimension without loops :+) @Variatus — T.M., Feb 17 '20 at 11:10

T.M. · Answer 2 · 2020-02-17T11:20:01.567

Alternative to ReDim Preserve

The correct solution of @Variatus uses an array with reversed row/column dimensions to overcome the limitation that ReDim Preserve only works at the last (here: 2nd) dimension.

Alternatively, I demonstrate a workaround which restructures the 1st dimension /i.e. rows/ directly (leaving the 2nd untouched) via Application.Index() function:

NewAssigneesArray= Application.Index(NewAssigneesArray, Evaluate("row(1:" & i & ")"), Array(1, 2, 3))

Related link

Read about some peculiarities of the the Application.Index() function" at Insert first column in datafield array without loops or API call

Compare two arrays and add matching strings to another array

2 Answers2