Sub First() Dim i As Integer Dim j As Integer Dim target As String Dim period As Integer For i = 2 To 298 Step 1 Worksheets(2).Activate target = Cells(i, 4) period = Cells(i, 3) Worksheets(3).Activate For j = 2 To 9 Step 1 If (Cells(j, 1) = target) Then If (Cells(j, 2) < period) Then period = Cells(j, 2) Worksheets(2).Activate Cells(i, 3) = period Exit For End If End If Next j Next i End Sub Sub Third() Dim period As Date Dim idOfBT As Long 'BT - Business Trip Dim idOfTheNextBT As Long j = 1 i = 2 idOfBT = 0 Do While Cells(i, 1) <> "" If Cells(i, 1) <> idOfBT Then 'new BT j = j + 1 idOfBT = Cells(i, 1) Worksheets(2).Activate period = Cells(j, 2) + Cells(j, 3) Worksheets(1).Activate End If 'correction k = i + 1 Do While (Cells(k, 2) <> Cells(i, 2)) And (Cells(k, 2) <> "") 'searching the next BT's id of accociate k = k + 1 Loop If Cells(k, 2) = "" Then i = i + 1 Else idOfTheNextBT = Cells(k, 1) Worksheets(2).Activate q = j + 1 Do While Cells(q, 1) <> idOfTheNextBT 'searching the row with information about the next BT of accociate q = q + 1 Loop periodOfTheNextBT = Cells(q, 2) Worksheets(1).Activate If period < periodOfTheNextBT Then i = i + 1 Else Rows(k).Delete i = i + 1 End If End If Loop End Sub