PDA

View Full Version : [SOLVED:] How to compare two arrays row by row?



waimea
12-04-2020, 07:47 AM
Hi,

I have two (or more) arrays and I am trying to compare the arrays row by row.

array1


Name
2020
2021
2022
2023


Test1
50
70
77
89


Test2
42
48
55
59


Test3
49
54
71
80



array2


Name
2020
2021
2022
2023


Test1
55
72
76
88


Test2
45
47
56
58


Test3
51
55
89
78




Expected output:

array3


Name
2020
2021
2022
2023


Test1
5
2
1
1


Test2
3
1
1
1


Test3
4
1
18
2










I don't know if it matters if is is array1 - array2 or vice versa and use of abs() function.

This is the code I have right now.



Sub test()


varray1 = Sheets("Sheet2").range("O4:Z28")
vArray2 = Sheets("Sheet2").range("AQ4:BB8")


ReDim varray3(1 To 26, 1 To 13)


Dim dup As Boolean: k = 1


For i = LBound(varray1, 1) To UBound(varray1, 1)
dup = False

For j = LBound(vArray2, 1) To UBound(vArray2, 1)
If varray1(i, 1) = vArray2(j, 1) Then
dup = True: Exit For
End If
Next j

If Not dup Then
varray3(k, 1) = varray1(i, 1)
k = k + 1
End If
Next i


End Sub

p45cal
12-04-2020, 10:43 AM
In the attached is a non-macro way using Power Query (Get & Transform Data).
The two blue tables are your source tables and the green table is the result table.
The green table is currently modelled on the first blue table meaning that it will always contain the same column headers and row headers as the first blue table. That behaviour can be changed if the headers in the 2 blue tables are different. Update the green table by right-clicking on it and choosing Refresh.

It's always difficult to guess what's in your sheet if you don't supply a workbook with your setup. So, for example, I don't know if the hard-coded ranges include row/column headers. There'll be other things I'll guess wrongly.

As an aside, and probably useless, is a formula at cell I7 which compares the two databodies of the arrays which spills into adjsacent cells and shows the differences, but it haas no regard for the headers at all.

Finally, what version of Excel are you using?

waimea
12-04-2020, 10:59 AM
Hi p45cal,

thank you for your reply.

I am using 365 and there are no headers in the data.

I am not great with powerquery!

Is it possible with a VBA approach?

Dave
12-04-2020, 11:53 AM
Hi waimea. It seems like some of your expected output is wrong. Anyways, I trialed your data for the 1st three years in sheet1 A to C with 1st array in rows 1 to 3 and 2nd array in rows 6 to 8. Output array is in rows 10 to 12. This code seems to work. HTH. Dave

Sub test()varray1 = Sheets("Sheet1").Range("A1:C3")
vArray2 = Sheets("Sheet1").Range("A6:C8")
ReDim vArray3(1 To 3, 1 To 3)


For i = LBound(varray1, 1) To UBound(varray1, 1)
For j = LBound(vArray2, 1) To UBound(vArray2, 1)
If varray1(i, j) <> vArray2(i, j) Then
vArray3(i, j) = vArray2(i, j) - varray1(i, j)
Else
vArray3(i, j) = 0
End If
Next j
Next i

With ThisWorkbook.Sheets("sheet1")
.Range(.Cells(10, "A"), .Cells(12, "C")) = vArray3
End With
End Sub

waimea
12-04-2020, 11:58 AM
Hi Dave,

thank you for your reply!

I think you are correct about the expected output being wrong, my bad!

I am going to try your code right away! :)

p45cal
12-04-2020, 12:03 PM
and there are no headers in the data.In that case the formula in cell I7 of my last attachment will suffice.

waimea
12-04-2020, 12:05 PM
Hi p45cal,

thank you for your reply!

You are talking about



=ABS(C5:F7-C11:F13)


That seems to work really well, how can I use that in VBA?

p45cal
12-04-2020, 12:23 PM
You are talking about



=ABS(C5:F7-C11:F13)


That seems to work really well, how can I use that in VBA?I don't understand why it would be necessary to use in VBA… any code would be more convoluted that the formula.

x = [ABS(C5:F7-C11:F13)]
will put into an array.

waimea
12-04-2020, 12:38 PM
Hi p45cal,

I learned something good and new tonight!

Thank you for your reply! The abs function is really sweet!

I want it in VBA with a commandbutton and now I have it working!

Paul_Hossler
12-04-2020, 12:46 PM
Another way would be to use a user defined function returning an array

No button or user action required, just normal Calc to update

27542



Option Explicit


Function CompareArrays(r1 As Range, r2 As Range) As Variant
Dim v1 As Variant, v2 As Variant, v3() As Variant
Dim r As Long, c As Long

CompareArrays = CVErr(xlErrNA)

v1 = r1.Value
v2 = r2.Value


If LBound(v1, 1) <> LBound(v2, 1) Then Exit Function
If LBound(v1, 2) <> LBound(v2, 2) Then Exit Function
If UBound(v1, 1) <> UBound(v2, 1) Then Exit Function
If UBound(v1, 2) <> UBound(v2, 2) Then Exit Function

ReDim v3(LBound(v1, 1) To UBound(v1, 1), LBound(v1, 2) To UBound(v1, 2))


For c = LBound(v1, 2) To UBound(v1, 2)
v3(1, c) = v1(1, c)
Next c


For r = LBound(v1, 1) To UBound(v1, 1)
v3(r, 1) = v1(r, 1)
Next r


For r = LBound(v1, 1) + 1 To UBound(v1, 1)
For c = LBound(v1, 2) + 1 To UBound(v1, 2)
v3(r, c) = Abs(v1(r, c) - v2(r, c))
Next c
Next r


CompareArrays = v3


End Function

waimea
12-04-2020, 12:56 PM
Hi Paul,

thank you for your reply!

that is surely some VBA wizardry! :)

I am looking at your attached file right now and I am trying to understand the code.

waimea
12-04-2020, 01:04 PM
Perhaps you could comment the code a bit? :)

Paul_Hossler
12-04-2020, 02:05 PM
Option Explicit


Function CompareArrays(r1 As Range, r2 As Range) As Variant
Dim v1 As Variant, v2 As Variant, v3() As Variant
Dim r As Long, c As Long

'set default return value in case of exit
CompareArrays = CVErr(xlErrNA)

'put each range into VBA array for speed
v1 = r1.Value
v2 = r2.Value


'make sure both arrays are the same size, exit if not (xlErrNA)
If LBound(v1, 1) <> LBound(v2, 1) Then Exit Function
If LBound(v1, 2) <> LBound(v2, 2) Then Exit Function
If UBound(v1, 1) <> UBound(v2, 1) Then Exit Function
If UBound(v1, 2) <> UBound(v2, 2) Then Exit Function

'create array for output same size as the inputs
ReDim v3(LBound(v1, 1) To UBound(v1, 1), LBound(v1, 2) To UBound(v1, 2))


'across all cols in row 1 to add years to output array
For c = LBound(v1, 2) To UBound(v1, 2)
v3(1, c) = v1(1, c)
Next c


'down all rows in col 1 to add names to output array
For r = LBound(v1, 1) To UBound(v1, 1)
v3(r, 1) = v1(r, 1)
Next r


'across non-name columns and down non-year rows to calculate abs(difference) and put in putput array
For r = LBound(v1, 1) + 1 To UBound(v1, 1)
For c = LBound(v1, 2) + 1 To UBound(v1, 2)
v3(r, c) = Abs(v1(r, c) - v2(r, c))
Next c
Next r


'return output array (with names, years, and differences) to worksheet as normal Excel worksheet functions
'!!!! must be array-entered and should be same size as input arrays
CompareArrays = v3


End Function

waimea
12-04-2020, 02:10 PM
Hi Paul,

thank you for your reply and for your comments.

I understand more of your code with your comments! :)

I am sorting the arrays by maximun value per year, as of now I am copying the arrays before I sort them, and then using your function.


Would it be possible for the function to "know" what value belongs to what "item"?

So that ever when I sort the data it would find the differences?

Paul_Hossler
12-04-2020, 06:22 PM
I am sorting the arrays by maximum value per year, as of now I am copying the arrays before I sort them, and then using your function.


Not sure I understand

snb
12-05-2020, 05:50 AM
2 lines suffice:


Sub M_snb()
ListObjects(1).Range.Copy ListObjects(1).Range.Offset(40)
ListObjects(3).DataBodyRange.Offset(, 1).Resize(, 11) = [index(ABS(P4:Z28-AR4:BB28),)]
End Sub

Assuming

Sheets("Sheet2").range("P4:Z28") = Listobjects(1)
Sheets("Sheet2").range("AR4:BB28")= Listobjects(2)

waimea
12-05-2020, 09:01 AM
Hi snb,

thank you for your reply!

I am not at home but I'll try your code later tonight!