Sub Test()
Dim i&, j&, k&, lr&, MaxSell&
Dim r As Range
Cells(1, 7).EntireColumn.Insert
j = 1
lr = Cells(Rows.Count, 6).End(xlUp).Row
Cells(lr, 7) = j
For i = lr To 2 Step -1
If Cells(i, 6) <> Cells(i - 1, 6) Then
j = j + 1
Cells(i, 6).EntireRow.Insert
Cells(i - 1, 7) = j
End If
Next i
For i = 1 To j - 1
Set r = Columns(7).Find(i, lookat:=xlWhole).CurrentRegion.Resize(, 6)
MaxSell = 0
For k = 1 To r.Rows.Count
If r(k, 2) = "SW SELL" And r(k, 4) > MaxSell Then MaxSell = r(k, 4)
Next k
For k = 1 To r.Rows.Count
If r(k, 2) = "SW BUY" And IsDate(r(k, 4)) And r(k, 4) < MaxSell Then r(k, 4).Interior.ColorIndex = 7
Next k
Next i
Columns(7).Delete
Rows(2).Delete
End Sub