Sub CopyFirstDate()
Dim ws As Worksheet
Dim rng As Range
Dim arr As Variant
Dim rowLast As Long, i As Long
Set ws = ActiveSheet ' Ideally change to = Worksheets("Your_Worksheet_Name")
With ws
rowLast = .Range("B" & Rows.Count).End(xlUp).Row
Set rng = .Range("A4:C" & rowLast)
arr = rng.Value
End With
For i = 1 To UBound(arr)
If Left(arr(i, 1), 7) = "Starts:" Then
arr(i - 1, 3) = arr(i + 2, 2)
End If
Next i
rng.Columns(3).Value = Application.Index(arr, 0, 3)
End Sub