principleMinor
Compare and match results in two two-dimensional arrays in Excel VBA
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!
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 FunctionSub 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 SubSolution
Couple notes -
-
Variable names - give your variables meaningful names:
-
-
What are the
If so, you can eliminate some variables as well
As far as reusing the
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.
resetting
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
- 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
Labelswill 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
lastRowfunction. If you do, I'd usePrivate Function LastRow(ByVal targetRange as Range) as Longand 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 arrayAs 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 iI'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 aXresetting
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 IfAlso, 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 arrayDim 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 iFor 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 aXIf arr1(aX, 3) = arr2(rowX, 1) Then
arr1(aX, 4) = arr2(rowX, 2)
Exit For
End IfContext
StackExchange Code Review Q#141691, answer score: 4
Revisions (0)
No revisions yet.