Compare and match results in two two-dimensional arrays in Excel VBA

Question

I have four loops to populate and compare two two-dimensional arrays then add the results to the first array before writing back to the active worksheet. Wondering if anyone has a cleaner alternate or more elegant method? It works as is but haven't tested it on large arrays yet!

Function lastRow(x As Range, y As Worksheet)

lastRow = y.Cells(Rows.Count, x.Column).End(xlUp).Row

End Function

---

Sub arrayMatch()

Dim arr1() As Variant
Dim arr2() As Variant
Dim rowX As Byte, colX As Byte, aX As Byte

Dim arr1x As Long, arr2y As Long

arr1x = lastRow(Range("A1"), ActiveSheet) 'returns the last row in the column for cell A1
arr2y = lastRow(Range("A1"), Sheets(2)) 'returns the last row in the column for cell A1 on sheet2

ReDim arr1(1 To arr1x, 1 To 4) As Variant 'dynamically sizes arr1 array
ReDim arr2(1 To arr2y, 1 To 2) As Variant 'dynamically sizes arr2 array

For rowX = 1 To arr1x 'arr1x is the last row in the active sheet and the end of array arr1
    For colX = 1 To 3 'only fills array up to 3rd dimension as 4th is reserved for the match results

        arr1(rowX, colX) = Cells(rowX, colX).Value 'set the Cells range to whatever your array is

    Next colX
Next rowX

For rowX = 1 To arr2y 'arr2y is the last row in sheet 2 and the end of array arr2
    For colX = 1 To 2

        arr2(rowX, colX) = Sheets(2).Cells(rowX, colX).Value

    Next colX
Next rowX

For aX = 1 To arr1x
    For rowX = 1 To arr2y
        If arr1(aX, 3) = arr2(rowX, 1) Then
            arr1(aX, 4) = arr2(rowX, 2)
            rowX = arr2y 'helps to exit array earlier when a match is found
        End If
    Next rowX
Next aX

For rowX = 1 To arr1x
    Cells(rowX, 4).Value = arr1(rowX, 4)
Next rowX

End Sub

Answer 1

This is a cleaner approach to filling the arrays.

Dim arr1, arr2

arr1 = Worksheets(1).Range("C1", Worksheets(1).Range("A" & Rows.Count).End(xlUp))
ReDim Preserve arr1(UBound(arr1, 1), 1 To 4)

arr2 = Worksheets(1).Range("B1", Worksheets(2).Range("A" & Rows.Count).End(xlUp))

Answer 2

Let me clear up a few misconceptions in your code:

lastRow(Range("A1"), ActiveSheet) ' returns the last row in the column for cell A1

This is not quite right... Remember: ActiveSheet is something that can change very easily. In the most cases it's a bad idea to rely on ActiveSheet when you can help it. I assume you always want to get the last row in column 1 for the first Worksheet in your Workbook.

incidentally the next line also includes a misconception that should be fixed with the same idea:

 lastRow(Range("A1"), Sheets(2)) ' returns the last row on the column for cell A1 on sheet2.

It's important to keep in mind that EXCEL supports more than just Worksheets. You cannot rely on Sheets to only contain Worksheets. Instead of Sheets or ActiveSheet you should use the Worksheets collection where possible:

arr1x = lastRow(Range("A1"), Worksheets(1))
arr2y = lastRow(Range("A1"), Worksheets(2))

---

For rowX = 1 To arr1x
    For colX = 1 To 3

        arr1(rowX, colX) = Cells(rowX, colX).Value

    Next colX
Next rowX

Two things here: for one I don't like how you have explicit additional newlines around the innermost block. And secondly you implicitly access the ActiveSheet. Cells is a property of Worksheet, and accordingly needs to be called on a Worksheet. Since you don't give one, VBA implicitly goes to the ActiveSheet.

In the same vein, Range("A1") refers to the active sheet and Worksheets(..) refers to the ActiveWorkbook ... For simplicity I've ignored that in the code I present here, but you may want to not rely on those implicit references. It should be clear how you can do that :)

As mentioned above, relying on ActiveSheet can bite you in the back (especially for long-running macros). Instead you should refer to Worksheets(1). I'd even go so far as to wrap your for-loops in a With-Block to reduce allocations:

With Worksheets(1)
    For rowX = 1 To arr1x
        For colX = 1 To 3
            arr1(rowX, colX) = .Cells(rowX, colX).Value
        Next colX
    Next rowX
End With

The With-block advice also applies for the next nested For-loop.

---

        rowX = arr2y 'helps to exit array earlier when a match is found

This can be written more succinctly with Exit For (which also makes the comment redundant)

Answer 3

Couple notes -

1. Your comments aren't needed. Comments - "code tell you how, comments tell you why". The code should speak for itself, if it needs a comment, it might need to be made more clear. If not, the comment should describe why you're doing something rather than how you're doing it. Here are a few reasons to avoid comments all together.
2. It's good practice to indent all of your code that way Labels will stick out as obvious.
3. Always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.

---

4. Variable names - give your variables meaningful names:

   • arr1 - this is the first array for comparison, why not describe what it is? Same for arr2.

   • What are the rowX, colX, ax, arr1x, arr2y? The capitalization isn't consistent - Standard VBA naming conventions have camelCase for local variables and PascalCase for other variables and names.

---

5. Creating and populating your arrays. I don't think you need the lastRow function. If you do, I'd use Private Function LastRow(ByVal targetRange as Range) as Long and just ensure you explicitly pass the range with the sheet qualifier.

If so, you can eliminate some variables as well

Dim arr1() As Variant
Dim arr2() As Variant
Dim lastRow As Long
lastRow = x 'target for firstarray
ReDim arr1(1 To lastRow, 1 To 4) As Variant 'dynamically sizes arr1 array
lastRow = x 'target for firstarray
ReDim arr2(1 To lastRow, 1 To 2) As Variant 'dynamically sizes arr2 array

As far as reusing the lastRow variables, just use Ubound(targetArray) instead.

Dim i As Long

For i = 1 To UBound(firstArray)
    firstArray(i, 1) = Cells(i, 1)
    firstArray(i, 2) = Cells(i, 2)
    firstArray(i, 3) = Cells(i, 3)
    secondarray(i, 1) = Sheet2.Cells(i, 1)
    secondarray(i, 2) = Sheet2.Cells(1, 2)
Next i

I'm not sure what you're doing here - populating the array? The other answer covers this - just populate it ater you dim it undimensioned.

---

For aX = 1 To arr1x
    For rowX = 1 To arr2y
        If arr1(aX, 3) = arr2(rowX, 1) Then
            arr1(aX, 4) = arr2(rowX, 2)
            rowX = arr2y 'helps to exit array earlier when a match is found
        End If
    Next rowX
Next aX

resetting rowX = arr2y is not the proper way to exit the loop:

If arr1(aX, 3) = arr2(rowX, 1) Then
   arr1(aX, 4) = arr2(rowX, 2)
   Exit For
End If

Also, why are you using aX as a byte for this? I don't understand that.

You can simplify the loops populating the arrays, combine everything into 1 loop and avoid looping 4 times. That should speed it up a bit. And I would really urge you to get rid of the arr1x and arr2y in favor or Ubound.

Answer 4

Thanks to everyone who answered my question, it's been a real eye opener and I feel sure that I am on my way to becoming a better VBA programmer. Following all the advice given, I have refactored the original code to the below.

Option Explicit
Option Base 1

---

Public Sub arrayMatch()

    Dim firstArray As Variant
    With ThisWorkbook.Worksheets(1)
        firstArray = .Range("A1", .Range("A1").End(xlDown).End(xlToRight))
    End With
    ReDim Preserve firstArray(UBound(firstArray, 1), 4)

    Dim secondArray As Variant
    With ThisWorkbook.Worksheets(2)
        secondArray = .Range("A1", .Range("A1".End(xlDown).End(xlToRight))
    End With

    Dim rowFirstArray As Long
    Dim rowSecondrray As Long
    For rowFirstArray = 1 To UBound(firstArray,1)   
        For rowSecondArray = 1 To UBound(secondArray,1)        
            If firstArray(rowFirstArray, 3) = secondArray(rowSecondArray, 1) Then            
                firstArray(rowFirstArray, 4) = secondArray(rowSecondArray, 2)            
                Exit For     
            End If    
        Next rowSecondArray
    Next rowFirstArray
    Erase secondArray

    For rowFirstArray = 1 To UBound(firstArray, 1)
        ThisWorkbook.Worksheets(1).Cells(rowFirstArray, 4).Value = firstArray(rowFirstArray, 4)
    Next rowFirstArray
    Erase firstArray

End Sub