VBA - compare two worksheets

[VictorKZ]

Hello everyone,

I'm having difficulty with how to make a VBA, which compares all the values of a worksheet in another.

I tried to do it this way, but it didn't work:

Sub CompareSheets()

Dim RowSheet1 As Long
Dim RowSheet2 As Long

RowSheet2 = 1

While Sheet2.Range("A" & RowSheet2).Value <> ""

RowSheet1 = 1

While Sheet2.Range("A" & RowSheet1).Value <> ""


If Sheet1.Range("A" & RowSheet1).Value = Sheet2.Range("A" & RowSheet2).Value Then

If Sheet1.Range("B" & RowSheet1).Value <> Sheet2.Range("B" & RowSheet2).Value Then

If Sheet1.Range("C" & RowSheet1).Value <> Sheet2.Range("C" & RowSheet2).Value Then

If Sheet1.Range("D" & RowSheet1).Value <> Sheet2.Range("D" & RowSheet2).Value Then

If Sheet1.Range("E" & RowSheet1).Value <> Sheet2.Range("E" & RowSheet2).Value Then

If Sheet1.Range("F" & RowSheet1).Value <> Sheet2.Range("F" & RowSheet2).Value Then

If Sheet1.Range("G" & RowSheet1).Value <> Sheet2.Range("G" & RowSheet2).Value Then

If Sheet1.Range("H" & RowSheet1).Value <> Sheet2.Range("H" & RowSheet2).Value Then

If Sheet1.Range("I" & RowSheet1).Value <> Sheet2.Range("I" & RowSheet2).Value Then

If Sheet1.Range("J" & RowSheet1).Value <> Sheet2.Range("J" & RowSheet2).Value Then

Sheet2.Range("A" & RowSheet2).Interior.Color = vbYellow
Sheet2.Range("B" & RowSheet2).Interior.Color = vbYellow
Sheet2.Range("C" & RowSheet2).Interior.Color = vbYellow
Sheet2.Range("D" & RowSheet2).Interior.Color = vbYellow
Sheet2.Range("E" & RowSheet2).Interior.Color = vbYellow
Sheet2.Range("F" & RowSheet2).Interior.Color = vbYellow
Sheet2.Range("G" & RowSheet2).Interior.Color = vbYellow
Sheet2.Range("H" & RowSheet2).Interior.Color = vbYellow
Sheet2.Range("I" & RowSheet2).Interior.Color = vbYellow
Sheet2.Range("J" & RowSheet2).Interior.Color = vbYellow

End If

End If

RowSheet1 = RowSheet1 + 1

Wend

RowSheet2 = RowSheet2 + 1


Wend


End Sub

Thanks for listening

 

[NdNoviceHlp]

Hi VictorKZ. You can trial this code. Please copy your wb before trialling the code. HTH. Dave

Public Sub CompareShts()
'compare sheet1 and sheet2
Dim RowCnt As Double, ColCnt As Integer, StartTemp As Variant
Dim Lastrow As Double, LastCol As Integer
On Error GoTo FixEr
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
StartTemp = Sheets("Sheet1").Cells(1, 1) 'temp store A1
If Sheets("Sheet1").Cells(1, 1) = vbNullString Then
Sheets("Sheet1").Cells(1, 1) = 1 'fill cell to set usedrange
End If

Lastrow = Sheets("Sheet1").UsedRange.Rows.Count
LastCol = Sheets("Sheet1").UsedRange.Columns.Count
For RowCnt = 1 To Lastrow 'loop sht rows
For ColCnt = 1 To LastCol 'loop sheet cols
'color similiar cells in blue
If LCase(Sheets("Sheet1").Cells(RowCnt, ColCnt)) <> _
       LCase(Sheets("Sheet2").Cells(RowCnt, ColCnt)) Then
Sheets("Sheet2").Cells(RowCnt, ColCnt).Interior.Color = vbCyan 'blue
'***To return to normal, comment out above line and remove comment below
'Sheets("Sheet2").Cells(RowCnt, ColCnt).Interior.Color = vbWhite 'white
Sheets("Sheet2").Cells(RowCnt, ColCnt).Borders.LineStyle = xlContinuous
Sheets("Sheet2").Cells(RowCnt, ColCnt).Borders.Color = RGB(170, 170, 170) 'grey
End If
Next ColCnt
Next RowCnt
Sheets("Sheet1").Cells(1, 1) = StartTemp
FixEr:
If Err.Number <> 0 Then
On Error GoTo 0
MsgBox "Error"
End If
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[Jambi46n2]

This is what I use, it highlights the differences between the two sheets, replace the "Sheets(1)" portions for the sheets you want:

Sub CompareTwoSheets()

If MsgBox("Highlight Discrepancies Between Sheet1 and Sheet2?", vbYesNo) = vbNo Then Exit Sub

'Check For Discrepancies and Highlight
    Dim x As Long
    x = 0
    Dim c As Range

    For Each c In Sheets(1).UsedRange
        If c.Text <> Sheets(2).Range(c.Address).Text Then
            c.Interior.Color = vbYellow
            x = x + 1
        End If
    Next c

MsgBox "There Are " & x & " Discrepancies"

End Sub

 

[VictorKZ]

Thanks a lot NdNoviceHlp and Jambi46n2.
These two solutions helped me a lot, thanks

 

[NdNoviceHlp]

You are welcome. Thanks for posting your outcome. Dave