This is the code you need -
Sub compare_lists()
With Worksheets("Result")
.Range("A1").Value = "BMK"
.Range("B1").Value = "From Page"
.Range("C1").Value = "To Page"
End With
Worksheets("Itemlist1").Range("A2:A" & Worksheets("Itemlist1").Range("A" & Rows.Count).End(xlUp).Row).Copy Worksheets("Result").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Worksheets("Itemlist2").Range("A2:A" & Worksheets("Itemlist2").Range("A" & Rows.Count).End(xlUp).Row).Copy Worksheets("Result").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Columns("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
Columns("A:A").ColumnWidth = 16.43
Cells.EntireRow.AutoFit
With Worksheets("Result")
lrow = .Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lrow
.Range("B" & i).FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-1],itemlist1!C[-1]:C,2,0),"""")"
.Range("C" & i).FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-2],itemlist2!C[-2]:C[-1],2,0),"""")"
Next i
.Range("B2:C" & lrow).Copy
.Range("B2:C" & lrow).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
For i = 2 To lrow
If .Range("B" & i).Value <> .Range("C" & i).Value And .Range("B" & i).Value <> "" And .Range("C" & i).Value <> "" Then
With .Range("A" & i).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ElseIf .Range("B" & i).Value <> .Range("C" & i).Value And .Range("B" & i).Value = "" Or .Range("C" & i).Value = "" Then
With .Range("A" & i).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next i
End With
End Sub
Bookmarks