How to check if cells in different sheets are equal? - vba

Question

Scenario: -There are 2 sheets being compared. Range for Sheet1 is B2:B and for Sheet2 is C2:C.
Requirement:
Sheet1 B2 = Sheet2 C2
Sheet1 B3 = Sheet2 C3 and so on...
See my existing code below:
Sub MessageCode()
Dim FoundBlank1 As Range
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")
Dim MyRange As Range, MyCell As Range, MyRange2 As Range, MyCell2 As Range
Set MyRange = ws.Range("B2:B" & ws.Range("B" & ws.Rows.Count).End(xlUp).Row)
Set MyRange2 = ws2.Range("C2:C" & ws2.Range("C" & ws2.Rows.Count).End(xlUp).Row)
Set MyCell2 = MyRange2
For Each MyCell In MyRange
If MyCell.Value <> Worksheets("Sheet2").Range("C2").Value Then
MyCell.Copy
Worksheets("Sheet3").Select
Set FoundBlank1 = Range("A1:A1000").Find(What:="", lookat:=xlWhole)
FoundBlank1.Select
Selection.PasteSpecial xlPasteValues
ActiveCell.Offset(0, 1).Value = "Incorrect Value."
End If
Next MyCell
End Sub

Answer 1

I've added in some extra message box if the number of rows of sheet 1 and 2 are not the same.
Try this:
Sub Messagecode()
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim lastrow1 As Integer
Dim lastrow2 As Integer
dim lastrow3 as integer
Dim i As Integer
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
ws1.Activate
lastrow1 = Cells(Rows.Count, 2).End(xlUp).Row
ws2.Activate
lastrow2 = Cells(Rows.Count, 3).End(xlUp).Row
If lastrow1 <> lastrow2 Then
MsgBox ("number of rows in Sheet1 is not equal to number of rows in Sheet2")
End If
For i = 2 To lastrow1
If ws1.Cells(i, 2) <> ws2.Cells(i, 3) Then
ws2.Cells(i, 3).Copy
Worksheets("Sheet3").Activate
lastrow3 = Cells(Rows.Count, 1).End(xlUp).Row
Cells(lastrow3, 1).Offset(1, 0).Activate
ActiveSheet.Paste
Cells(lastrow3, 1).Offset(1, 1) = "incorrect value"
End If
ws1.Activate
Next i
End Sub

Answer 2

You only need to set the last row for sheet1 and sheet3. run a loop from 2 to the lastrow and compare Sheet1.columnB with Sheet2.columnC if <> then copy the value in Sheet1 to Sheet3, offset 1 cell to the right and paste your text. You add +1 to the last row in Sheet3 so you don't keep writing over the same cell...
Dim i As Long
Dim lRow As Long
lRow = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row
Dim lRow3 As Long
lRow3 = Sheet3.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lRow
If Sheet1.Cells(i, "B").Value <> Sheet2.Cells(i, "C").Value Then
Sheet3.Cells(lRow3, "A").Value = Sheet1.Cells(i, "B").Value
Sheet3.Cells(lRow3, "A").Offset(, 1).Value = "Incorrect Value."
End If
lRow3 = lRow3 + 1
Next i