Add current date if missing first row with data

[Livin404]

Greetings, I am hoping someone may be able to finish the macro I provided. The macro seen below works great and no problems in inserting a date and time for missing dates. What I would love to happen is to read the top date and if there is “no current date” input the date immediately above the following date. Within the macro you will see what additional info I would like to be included. I’m hoping it just a little tweak for the macro does everything I need it to but provide a current date if needed. Thank you so much. The VBA is.

Option Explicit

Sub InsertMissingDates()
    ' 111
    
    Dim NextDate    As Variant
    Dim CellVal     As Variant
    Dim R           As Long                     ' loop counter: Rows
    
    R = Cells(Rows.Count, "D").End(xlUp).Row
    NextDate = CellDate(Cells(R, "D"))
    If NextDate = vbError Then Exit Sub
    
    ' bottom rows must be inserted before top rows
    For R = R - 1 To 2 Step -1
        CellVal = CellDate(Cells(R, "D"))
        If CellVal = vbError Then Exit For       ' exit if date can't be recognised
        
        Do While Int(CDbl(CellVal)) < Int(CDbl(NextDate - 1))
            Rows(R + 1).Insert Shift:=xlDown
            With Cells(R + 1, "D")
                .Value = Int(CDbl(NextDate - 1))
                .NumberFormat = "dd mmm yyyy hhmm"
                .HorizontalAlignment = xlLeft
            End With
            Cells(R + 1, "A").Value = "NO DEPARTURES"
            Cells(R + 1, "B").Value = "N/A"
            Cells(R + 1, "C").Value = "N/A"
            NextDate = NextDate - 1
        Loop
        NextDate = CellVal
    Next R
End Sub

Private Function CellDate(Cell As Range) As Variant
    ' 111
    ' return vbError if cell's value couldn't be converted to a date
    
    Dim Fun         As Variant              ' function return value
    Dim CellVal     As Variant
    Dim Sp()        As String
    
    CellVal = Cell.Value
    If IsDate(CellVal) Then
        Fun = CDate(CellVal)
    Else
        Sp = Split(CellVal, " ")
            
        If UBound(Sp) = 3 Then
            Sp(3) = Right("0000" & Sp(3), 4)
            Sp(3) = Left(Sp(3), 2) & ":" & Right(Sp(3), 2)
            On Error Resume Next
            Fun = CDate(Join(Sp))
        End If
    End If
    If VarType(Fun) <> vbDate Then
            MsgBox """" & CellVal & """ in row " & Cell.Row & vbCr & _
                   "couldn't be converted to a date.", _
                   vbInformation, "Data format error"
            Fun = vbError
    End If
    CellDate = Fun
End Function