Sub CompareSheet1Sheet2()
' hiker95, 08/16/2014, ME799278
Dim w1 As Worksheet, w2 As Worksheet, w3 As Worksheet
Dim lr1 As Long, lr2 As Long
Dim c As Range, s1a As Range, s2a As Range
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
Set w3 = Sheets("Sheet3")
lr1 = w1.Cells(Rows.Count, 1).End(xlUp).Row
lr2 = w2.Cells(Rows.Count, 1).End(xlUp).Row
If lr1 = lr2 Then
w3.Columns(1).Resize(, 3).ClearContents
w3.Range("A1:B" & lr1).Value = w1.Range("A1:B" & lr1).Value
w3.Columns(1).Resize(, 3).AutoFit
ElseIf lr1 > lr2 Then
w3.Columns(1).Resize(, 3).ClearContents
w3.Range("A1:B" & lr1).Value = w1.Range("A1:B" & lr1).Value
With w3
For Each c In .Range("A1", Range("A" & Rows.Count).End(xlUp))
Set s1a = w1.Columns(1).Find(c.Value, LookAt:=xlWhole)
Set s2a = w2.Columns(1).Find(c.Value, LookAt:=xlWhole)
If Not s1a Is Nothing And s2a Is Nothing Then
c.Offset(, 2) = "this was in Sheet1, but not in Sheet2"
End If
Set s1a = Nothing
Set s2a = Nothing
Next c
.Columns(1).Resize(, 3).AutoFit
End With
ElseIf lr1 < lr2 Then
w3.Columns(1).Resize(, 3).ClearContents
w3.Range("A1:A" & lr2).Value = w2.Range("A1:A" & lr2).Value
w3.Range("A1:A" & lr2).Sort key1:=w3.Range("A1"), order1:=1
w3.Range("B1:B" & lr1).Value = w1.Range("B1:B" & lr1).Value
With w3
For Each c In .Range("A1", Range("A" & Rows.Count).End(xlUp))
Set s1a = w1.Columns(1).Find(c.Value, LookAt:=xlWhole)
Set s2a = w2.Columns(1).Find(c.Value, LookAt:=xlWhole)
If s1a Is Nothing And Not s2a Is Nothing Then
c.Offset(, 2) = "this was in Sheet2, but not in Sheet1"
End If
Set s1a = Nothing
Set s2a = Nothing
Next c
.Columns(1).Resize(, 3).AutoFit
End With
End If
Application.ScreenUpdating = True
End Sub