(vba) compare two arrays, range by range

[montecarlo2012]

Hi

Sub compare_two_array()
   Dim B As Variant
   Dim A As Variant

   B = Range("B2:F13").Value
   A = Range("I2:M13").Value
   counter = 1
   While counter <= UBound(B)
      X = B(counter, 1)
      Y = A(counter, 1)
      If X = Y Then
         Range("o2:o13").Value = "match"
         
      Else: Range("o2:o13").Value = "no"
      End If
      counter = counter + 1
   Wend
End Sub

Trying to compare two arrays, "range by range".

I will explained the obvious to avoid wrong interpretation

If I have the following sequences in an array
(this is a small example only)
1 2 3
1 3 2
2 3 1
2 1 3
3 2 1
3 1 2
And I want to compare “range” by “range” against the second array
2 3 1
4 5 6
3 1 2
The duplicates here will be only two 231 and 312
Well, my real data location is (“B2:F5000”) array1
To compare against (“I2:M100”)
On column I would like to see “match” or “no”

Thank you for your time, reading this.

Is just a little ilustration, thanks.

 

[bebo021999]

Try:

Option Explicit
Sub test()
Dim i&, j&, lrX, lrY, X, Y, rng As Range, result
lrX = Cells(Rows.count, "B").End(xlUp)
lrY = Cells(Rows.count, "I").End(xlUp)

'combine 1st range
Set rng = Range("B2:B" & lrX)
X = Evaluate(rng.Address & "& -" & rng.Offset(, 1).Address & "& -" & rng.Offset(, 2).Address _
& "& -" & rng.Offset(, 3).Address & "& -" & rng.Offset(, 4).Address)

    'combine 2nd range
    Set rng = Range("I2:M" & lrY)
    Y = Evaluate(rng.Address & "& -" & rng.Offset(, 1).Address & "& -" & rng.Offset(, 2).Address _
    & "& -" & rng.Offset(, 3).Address & "& -" & rng.Offset(, 4).Address)
    
        Range("O2:O1000000").ClearContents
        result = Range("O2:O" & lrX).Value
        For i = 1 To UBound(X)
            For j = 1 To UBound(Y)
                If X(i, 1) = Y(j, 1) Then
                    result(i, 1) = "Match"
                    GoTo z
                End If
            Next
z:
            If result(i, 1) = "" Then result(i, 1) = "No"
        Next
        Range("O2:O" & lrX).Value = result
End Sub

 

[montecarlo2012]

Hi, bebo, sorry do not work. I just duplicate some intentionally and the answer was -no-.

 

[bebo021999]

Which row that the code does not work? Could you post sample with more rows and desired output?
For each row of left table, then look for matching row in right table. Is it your requirement?

 

[snasui]

Please try,

Sub compare_two_array()
    Dim rall As Range, r As Range
    With ActiveSheet
        Set rall = .Range("b2").CurrentRegion.Columns(1).Cells
        For Each r In rall
            If VBA.Join(Application.Transpose(Application.Transpose(r.Resize(, 5)))) = _
                VBA.Join(Application.Transpose(Application.Transpose(.Cells(r.Row, "i").Resize(, 5)))) Then
                .Cells(r.Row, "o").Value = "match"
            Else
                .Cells(r.Row, "o").Value = "no"
            End If
        Next r
    End With
End Sub

 

[montecarlo2012]

Thanks snasui. this is what happen when I run your code/
lines 14 to 20 are equal

is correct the line from 1 to 13 = no, and incorrect the lines from 14 to 20, they are a match.

 

[snasui]

Please try again with this code,

Sub compare_two_array()
    Dim d As Object, strD As String, strC As String
    Dim rall As Range, r As Range
    Dim rall1 As Range, r1 As Range
    Set d = CreateObject("Scripting.Dictionary")
    With ActiveSheet
        Set rall = .Range("b2").CurrentRegion.Columns(1).Cells
        For Each r In rall
            strD = VBA.Join(Application.Transpose(Application.Transpose(r.Resize(, 5))))
            If Not d.Exists(strD) Then
                d.Add Key:=strD, Item:=strD
            End If
        Next r
       
        Set rall1 = .Range("i2").CurrentRegion.Columns(1).Cells
        For Each r1 In rall1
            strC = VBA.Join(Application.Transpose(Application.Transpose(r1.Resize(, 5))))
            If Not d.Exists(strC) Then
                .Cells(r1.Row, "o").Value = "no"
            Else
                .Cells(r1.Row, "o").Value = "match"
            End If
        Next r1
    End With
End Sub

 

[montecarlo2012]

Snasui, Thank you, I marked as solution. work great.

 

[snasui]

You are welcome.

 

[Rick Rothstein]

I know you have a solution, but I thought you mind find this more compact macro to be of interest...

Sub compare_two_array()
  Dim R As Long, LastRow As Long, FullRange As String, RowRange As Variant
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  FullRange = Join(Application.Transpose(Evaluate(Replace(""" ""&B2:B#&"" ""&C2:C#&"" ""&D2:D#&"" ""&E2:E#&"" ""&F2:F#&"" """, "#", LastRow))))
  LastRow = Cells(Rows.Count, "I").End(xlUp).Row
  RowRange = Intersect(Range("2:" & LastRow), Columns("I:M"))
  For R = 1 To UBound(RowRange)
    Cells(1 + R, "N") = Mid("YesNo", 1 - 3 * (InStr(FullRange, Join(Application.Index(RowRange, R))) = 0), 3)
  Next
End Sub