Option Explicit Sub test() Dim r1 As Range Dim r2 As Range Dim wsT As Worksheet Dim i As Long, j As Long Dim s As String Dim d As Long Set r1 = Worksheets("Sheet1").Cells(1).CurrentRegion Worksheets("Sheet2").Copy Set wsT = ActiveSheet Set r2 = wsT.Cells(1).CurrentRegion r2.Sort r2.Columns(6), xlDescending For i = 1 To r1.Rows.Count r1.Cells(i, 9).Value = "Error" s = r1.Cells(i, 2).Value & r1.Cells(i, 3).Value d = r1.Cells(i, 6).Value2 For j = 1 To r2.Rows.Count If s = r2.Cells(j, 2).Value & r2.Cells(j, 3).Value Then If d >= r2.Cells(j, 6).Value2 Then r2.Rows(j).Copy r1.Cells(i, 9) Exit For End If End If Next Next wsT.Parent.Close False End Sub