VB Code to fill up certain cells with text.

Hello:

Please refer to attached file.
I have data in the file as shown in file.

I need VB code to fill up the employee Names in yellow highlighted cells.
Once that is done, need to delete all rows with Green highlighted.

Logic is to fill up employee names next to date and delete the rest of the rows.


Let me know if you have any questions.
Thanks.

Sub Test()

LR = Cells(Rows.Count, 1).End(xlUp).Row

Optimise (True)

With Range("J4:J" & LR)
    .FormulaR1C1 = "=IF(OR(RC[-8]="""",RC[-8]=""Signature""),R[-1]C,RC[-8])"
    .Value = .Value
End With
With Range("K4:K" & LR)
     .FormulaR1C1 = "=IF(OR(RC[-8]="""",RC[-8]=""Job""),"""",RC[-1])"
    .Value = .Value
    Range("B4:B" & LR).Value = .Value
    
End With

   
    Range("K4:K26").Select
    Selection.Replace What:="", Replacement:="#N/A", LookAt:=xlPart _
        , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
    
    Range("J:K").Delete
    Range("A1").Select
Optimise (False)

End Sub

Private Sub Optimise(F As Boolean)

'F is the functions Disable Flag

F = Not F

Application.ScreenUpdating = F
Application.DisplayAlerts = F
Application.EnableEvents = F
ActiveSheet.DisplayPageBreaks = F

Application.DisplayStatusBar = F

If F = False Then
Application.Calculation = xlCalculationManual
Else
Application.Calculation = xlCalculationAutomatic
End If

End Sub