Try this code to see if this works as per your requirement.
Sub comparevalues()
Dim rng, rng1, cell As Range
Dim lr As Long
Dim n As Integer
lr = Cells(Rows.Count, 2).End(xlUp).Row
Set rng = Range("B2:B" & lr)
Set rng1 = Range("P2:P" & lr)
Application.ScreenUpdating = False
For Each cell In rng
On Error Resume Next
n = WorksheetFunction.Match(cell, rng1, 0)
If Err = 0 Then
If cell.Offset(0, 1) <> Cells(n + 1, "Q") Then
Cells(n + 1, "R") = "Wrong Amount"
End If
End If
Err = 0
Next cell
Columns("R").AutoFit
Application.ScreenUpdating = True
End Sub
See the attached sheet.
Bookmarks