How to compare cells one by one between two Excel sheets? - excel

Question

I'm trying to write a VBA code and I'm having some issues.
Here's the context, I have an Excel spreadsheet with two sheets, "Sheet1" and "Sheet2"
I want my VBA code to compare two rows of cells.
Here's what my Sheet1 looks like:
And here's what my Sheet2 looks like:
As you can see, I have the same number of cells to compare however, one of them is not the same.
What I want my VBA code to do, is to compare one by one the cells between Sheet1 and Sheet2. And once the code spots two cells who are not identical, a MsgBox appears saying "Cells are not the same". In that case, it is for cells "D1"
It sounds pretty basic and simple to do, but I'm really struggling.
Here are the first lines of code I have but it doesn't work:
Dim RangeSheet1 As Range, RangeSheet2 As Range
Set RangeSheet1 = Worksheets("Sheet1").Range("A1")
Set RangeSheet2 = Worksheets("Sheet2").Range("A1")
Do While RangeSheet1.Value = RangeSheet2.Value
RangeSheet1.Offset(0,1)
RangeSheet2.Offset(0,1)
Loop
MsgBox "Cells are not the same"
Do you guys have any idea how I can do it the right way?
Thank you very much for your help.

Answer 1

I wrote a solution that compares all the cells in the sheets using a for loop. It exits the for loop when two cells are not equal, but if you need to compare more cells you can just remove that row. There are more efficient macros but this is a solution that I think should work for your needs.
Sub compareSheets()
Dim sht1 As Worksheet, sht2 As Worksheet, cell As Object
Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Sheet2")
For Each cell In sht1.Cells
Dim currentCellAddress As String
currentCellAddress = Replace(cell.Address, "$", "")
If Not cell.Value = sht2.Range(currentCellAddress).value Then
MsgBox "The cell " & currentCellAddress & " is not the same in both sheets."
Exit For
End If
Next cell
End Sub
EDIT:
I saw you to collect all the non-equal cells in a message box at the end. Then in that case, something like this should do the trick:
Sub compareSheets()
Dim sht1 As Worksheet, sht2 As Worksheet, cell As Object, refArray() As String, refCount As Integer
refCount = 0
Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Sheet2")
For Each cell In sht1.Cells
Dim currentCellAddress As String
currentCellAddress = Replace(cell.Address, "$", "")
If Not cell.Value = sht2.Range(currentCellAddress).Value Then
ReDim Preserve refArray(0 To refCount)
refArray(refCount) = currentCellAddress
refCount = refCount + 1
End If
Next cell
Dim resultText As String, ref As Variant
For Each ref In refArray
resultText = resultText & " " & ref
Next ref
MsgBox "The following cells are not equal " & vbCrLf & resultText
End Sub