Macro to compare two data sets

 1. Object of the macro

a)The data is populated as follows:

b) I want to compare based on the Unique identifier List A and List B

c) Highlight the common items in List A and List B

d) Get populated in Sheet 2, items present in List A, but not in List B

e)Get populated in Sheet 3, items present in List B, but not in List A

2. Code

Sub Comparedatasets()

Application.ScreenUpdating = False

lr1 = Range("A" & Rows.Count).End(xlUp).Row

lr2 = Range("D" & Rows.Count).End(xlUp).Row

Sheets(1).Range("A2", "B2").Copy

Sheets(2).Range("A1").PasteSpecial Paste:=xlPasteValues

Sheets(3).Range("A1").PasteSpecial Paste:=xlPasteValues

check = False

For r = 3 To lr1

Set compare1 = Cells(r, 1)

For q = 3 To lr2

Set Compare2 = Cells(q, 4)

If compare1 = Compare2 Then Compare2.Interior.Color = vbYellow: check = True

Next q

If check = False Then

Range(compare1, compare1.End(xlToRight)).Copy

Sheets(3).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _Paste:=xlPasteValues

End If

check = False

Next r  

check = False

For r = 3 To lr2

Set compare1 = Cells(r, 4)

For q = 3 To lr1

Set Compare2 = Cells(q, 1)

If compare1 = Compare2 Then Compare2.Interior.Color = vbYellow: check = True

Next q 

If check = False Then

Range(compare1, compare1.End(xlToRight)).Copy

Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _Paste:=xlPasteValues

End If

check = False      

Next r

Application.ScreenUpdating = True

End Sub

3) Result