HiveBrain v1.2.0
Get Started
← Back to all entries
principleMinor

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

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
arraysexcelmatchdimensionaltwovbaandresultscompare

Problem

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

Solution

Couple notes -

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



  • It's good practice to indent all of your code that way Labels will stick out as obvious.



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



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

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

Code Snippets

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
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
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
If arr1(aX, 3) = arr2(rowX, 1) Then
   arr1(aX, 4) = arr2(rowX, 2)
   Exit For
End If

Context

StackExchange Code Review Q#141691, answer score: 4

Revisions (0)

No revisions yet.