Comparing Ranges in VBA

[aa2000]

Hi

Firstly, I have to say that I am very new to VBA and have hardly used it before.

So I have 3 ranges on a worksheet, with the zeros lining up with each number above:

Range 1:
25 50 85 180 350 500 650 850
0 0 0 0 0 0 0 0

Range 2:
25 50 85 180 350 500 650 850
0 0 0 0 0 0 0 0

Range 3:
20 40 80 160 280 400 500 600
0 0 0 0 0 0 0 0

So I need to compare range 2 with range 1 and if and only if all the values in each cell are exactly the same should "OK" be printed in a certain cell in the worksheet
I also need to do exactly the same thing for range 3 and range 1. I do not want the user to have to select the range themselves, instead I want that to be defined in the macro itself, and the two comparisons can be made in separate macros.

Currently I have this code, but it prints OK all the time:

Sub Check_TEST2()
Dim CompareRange As Variant, x As Variant, y As Variant
Set CompareRange = Range("")
Set CompareRange2 = Range("")
For Each x In CompareRange2
For Each y In CompareRange
If x <> y Then Cells(16, 33) = "NOT OK"
If x = y Then Cells(16, 33) = "OK"
Next y
Next x
End Sub

Can anyone show me what macro would solve this?

Thanks for any help!

 

[poolhall]

Let's say your first range is A1:H2, the second A4:H5, both on sheet1:

Sub CompareRanges()
Dim myRange As Range, c As Range

Set myRange = Sheet1.Range("A1:H2")
Sheet1.Cells(16, 33).Value = ""

For Each c In myRange
    If c <> c.Offset(3) Then
        Sheet1.Cells(16, 33).Value = "Not OK"
        Exit For
    End If
Next c

If Sheet1.Cells(16, 33).Value = "" Then Sheet1.Cells(16, 33).Value = "OK"

End Sub

to compare your 3rd range with the 1st, change offset values appropriately.

 

[Marcelo Branco]

Or you can use this UDF

Function compRanges(rng1 As Range, rng2 As Range) As String
    Dim r1 As Variant, r2 As Variant
    Dim i As Long, j As Long
 
    'Check if ranges are the same size
    If rng1.Rows.Count <> rng2.Rows.Count Or rng1.Columns.Count <> rng2.Columns.Count Then _
        MsgBox "Ranges must be the same size": Exit Function
 
    r1 = rng1
    r2 = rng2
 
    For i = LBound(r1, 1) To UBound(r1, 1)
        For j = LBound(r1, 2) To UBound(r1, 2)
            'Compare each element of r1 with r2
            If r1(i, j) <> r2(i, j) Then compRanges = "Not OK": Exit Function
        Next j
    Next i
 
    compRanges = "OK"
End Function

In your macro use something like

Cells(16, 33) = compRanges(Range("A1:H2"), Range("A4:H5"))

HTH

M.

 

[Sthrncali]

Here is my solution...

This will build two txt strings using each cell value in each respective range, and compare them for a match..

Sub TestMatch()
Dim Rng1 As Range, Rng2 As Range
Dim Str1 As String, Str2 As String
Dim Match As String

Set Rng1 = Range("A1:C1")
Set Rng2 = Range("A6:C6")
For Each cell In Rng1
Str1 = Str1 & cell.Value
Next
For Each cell In Rng2
Str2 = Str2 & cell.Value
Next
If Str1 = Str2 Then
Match = "Yes"
Else
Match = "No"
End If
MsgBox Match
End Sub

 

[Biz]

Or you can use this UDF

Function compRanges(rng1 As Range, rng2 As Range) As String
    Dim r1 As Variant, r2 As Variant
    Dim i As Long, j As Long
 
    'Check if ranges are the same size
    If rng1.Rows.Count <> rng2.Rows.Count Or rng1.Columns.Count <> rng2.Columns.Count Then _
        MsgBox "Ranges must be the same size": Exit Function
 
    r1 = rng1
    r2 = rng2
 
    For i = LBound(r1, 1) To UBound(r1, 1)
        For j = LBound(r1, 2) To UBound(r1, 2)
            'Compare each element of r1 with r2
            If r1(i, j) <> r2(i, j) Then compRanges = "Not OK": Exit Function
        Next j
    Next i
 
    compRanges = "OK"
End Function

In your macro use something like

Cells(16, 33) = compRanges(Range("A1:H2"), Range("A4:H5"))

HTH

M.

What can I say it's elegant!

Biz

 

[aa2000]

Thank you all for the quick replies. They were very useful and I was able to solve this problem.