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

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.

CodePudding user response：

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
        Exit For
        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