Hi Stephen

Another way to do it listed below.

Option Explicit
Dim MyCell, MyRng1, MyRng2 As Range
Dim FoundCell As Range
Dim c As Integer
Private Sub CommandButton1_Click()

Worksheets("Compare").Activate

Set MyRng1 = Range("H2:H" & [G65535].End(xlUp).Row)
Set MyRng2 = Range("D6:D" & [D65535].End(xlUp).Row)

For Each MyCell In MyRng1

Set FoundCell = MyRng2.Find(What:=MyCell, LookAt:=xlWhole)

If FoundCell Is Nothing Then

c = Worksheets("Results").[D65535].End(xlUp).Row + 1

Worksheets("Results").Cells(c, 4).Value = _
MyCell.Offset(0, -1).Value
Worksheets("Results").Cells(c, 5).Value = _
MyCell.Value

End If

Next MyCell

End Sub

Hope this helps