Insert Missing date

Question

Greetings I have a couple VBA formulas that work great. What I need is the VBA is to insert a blank row and fill up the fill the row with data identified in the macro.

In Column E a "Julian date" is listed as 1335/1951. 1335 represents 01 Dec and 1951 is Zulu Time in 24 hours. There is no ":" which is intended. The following formula converts the Julian Date to Georgian Calendar and the time in Local. This will put 01 Dec 2021 0835. In addition the macro copies it's own column and pastes values in Column F. Column E is deleted and then Column F becomes the new Column E with the Custom Format "dd mmm yyyy hhmm". The first two macros work as desired.

The following makes all what I describe happen:

VBA Code: Sub CopyJulianUDFFormulas_Calculate_DeleteJulianFormulas_DeleteOriginalJulianDataColumn() ' Range("F1").Formula = "= julian(E1)" ' Copy formula to cell Range("F1").AutoFill Destination:=Range("F1:F" & Range("E" & Rows.Count).End(xlUp).Row) ' Copy Formula down the range ' With Range("F1:F" & Range("E" & Rows.Count).End(xlUp).Row) ' Loop through the formula column .Value = .Value ' Remove formulas from cell leaving just the value .NumberFormat = "d mmm yyyy h:mm:ss AM/PM" End With ' Range("E:E").EntireColumn.Delete ' Delete source column F which is no longer needed End Sub

Public Function Julian(JulianDateString As String)              ' Use as a formula on sheet ie. = Julian(E1) where E1 might = 1326/2230
'                                                               '   4 digit Julian date is only good for 10 years. ;)
    Dim ConvertedDate       As Date
    Dim TimePortion         As Date
    Dim CalenderDays        As Long
    Dim CalenderYear        As Long
    Dim JulianFinalResult   As String
    Dim JulianDate          As String
'
    JulianDate = Left(JulianDateString, 4)
    CalenderDays = CLng(Right(JulianDate, 3))
'
    If Len(JulianDate) < 4 Then
        CalenderYear = 2020
    Else
        CalenderYear = 2020 + CLng(Left(JulianDate, 1))
    End If
'
    ConvertedDate = DateSerial(CalenderYear, 1, CalenderDays)                                                   ' Returns a Date
'
    TimePortion = TimeValue(Left(Right(JulianDateString, 4), 2) & ":" & Right(Right(JulianDateString, 4), 2))   ' Returns a Time
'
    JulianFinalResult = Format(ConvertedDate + TimePortion - TimeSerial(5, 0, 0), "d mmm yyyy h:mm AM/PM")      ' Returns a Date/Time string
'
    Julian = JulianFinalResult                                                                                  ' Save Result to Function
End Function

This is the formula I'm trying to use, but unfortunately it is erroring out. I am just simply trying to insert rows where dates are missing.

Sub InsertMissingDates()
   Dim x As Long, diff As Long
Dim LastRow As Long
Dim StartRow As Long
If Int(Cells(1, "E")) <> Date Then
        Rows(1).Insert
        Cells(1, "E").Value = Date
        Cells(1, "C").Value = "N/A"
        Cells(1, "B").Value = "N/A"
        Cells(1, "D".Value = "N/A"
        Cells(1, "A").Value = "NO DEPARTURES"
End If
StartRow = 2
LastRow = Cells(Rows.Count, "E").End(xlUp).Row
For x = LastRow To StartRow Step -1
diff = DateDiff("E", Cells(x - 1, "E"), Cells(x, "E"))
    If diff > 1 Then
       Rows(x).Insert
       Cells(x, "E").Value = Int(Cells(x + 1, "E")) - 1
       Cells(x, "C").Value = "N/A"
       Cells(x, "B").Value = "N/A"
       Cells(x, "D").Value = "N/A"
       Cells(x, "A").Value = "NO DEPARTURES"
       x = x + 1
    End If
Next x
Cells(1, "E").EntireColumn.NumberFormat = "dd mmm yyyy hhmm"
End Sub

Answer 1

Hi there

Your first macro could be reduced to:

'''''**************************************************************************************************

Sub CopyJulianUDFFormulas_Calculate_DeleteJulianFormulas_DeleteOriginalJulianDataColumn()

With Range("F1:F" & Range("E" & Rows.Count).End(xlUp).Row) 

    .Formula = "= julian(E1)"      ' Copy Formula the entire range in one go 

    .Value = .Value    '   Remove formulas from cell leaving just the value 

    .NumberFormat = "d mmm yyyy h:mm:ss AM/PM"   '' format cells 

End With 

Range("E:E").EntireColumn.Delete  ' Delete source column F which is no longer needed 

End Sub

'''*******************************************************************************************************

Simply misspellings

1) A closing parenthesis missing

2) Replace "E" (your column) with "d", the date interval argument in the DateDiff function.

I tested the amended code on my side and works perfectly.

I hope this helps you and gives a solution to your question.

Regards

Jeovany

Answer 2

That works beautiful, thank you so much. I was just a little off. Annoyed I spent so much time when it was a rather simple fix.

Have a wonderful day.