Sub BackFrom4to3()
Dim lastrow, myArea As Range, errorArea As Range
Application.ScreenUpdating = False
Application.Goto Sheets("4to3").Range("a1")
Columns("a:f").ClearContents
Sheets("Sheet1").Columns("a:e").Copy Range("a1")
lastrow = Cells(Rows.Count, "c").End(xlUp).Row
If lastrow = 1 Then Exit Sub
Set myArea = Range(Cells(2, "a"), Cells(lastrow, "e"))
myArea.Sort key1:=[c1], order1:=xlAscending, key2:=[b1], order2:=xlAscending, Header:=xlNo
myArea.Columns(1).Offset(, 5).FormulaR1C1 = _
"=IF(AND(RC[-3]=R[1]C[-3],RC[-1]=""phase 4"",R[1]C[-1]=""phase 3""),R[1]C[-4],NA())"
myArea.Columns(1).Offset(, 5).NumberFormat = Range("b2").NumberFormat
myArea.Columns(1).Offset(, 5) = myArea.Columns(1).Offset(, 5).Value
On Error Resume Next
myArea.Columns(1).Offset(, 5).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
On Error GoTo 0
[f1] = "Back to phase 3"
End Sub