Coverting 4 digit/time Julian date to Calendar date/time using VBA.

[Livin404]

Greetings,

I have a Julian Date of 1326/2230 which I would need to be dispalyed as 22 Nov 2021 2230 and another example 1326/0025 which would be displayed as 22 Nov 2021 0025.
I'm thinkingI will have to use some sort of text to columns which will separate the date and time while droping the "/". Then I'll have to insert the first digit in front of the four numbes. After I get 1326 sepaeated I can add a 2 for all dates.

Sub test()
lastrow = Worksheets("Sheet1").Cells(Rows.Count, "F").End(xlUp).Row
For Each cell In Range("F1:F" & lastrow)
cell.Value = "2" & cell.Value
Next

End Sub

I do know

=DATE(IF(0+(LEFT(A1,2))<30,2000,1900)+LEFT(A1,2),1,RIGHT(A1,3))

will get me the Calendar date from a 5 digit Julian Date , but I need this in a VBA for Column G.

I need someway of Concating the date and time- bear in mine I need to have the 24 clock. Soon as I remove the/ I loose all leading zeros.

Thank you,

 

[johnnyL]

I do know

=DATE(IF(0+(LEFT(A1,2))<30,2000,1900)+LEFT(A1,2),1,RIGHT(A1,3))

will get me the Calendar date from a 5 digit Julian Date ...

Since You are dealing with a 4 digit Julian Date, I have 2 formulas that should work with that. Keep in mind that a 4 digit Julian Date is only good for 10 years due to only 1 digit being used for the year.

Assuming the 4 digit Julian Date is in A1 ...
=DATE((LEFT(A1,1)+2020),1,RIGHT(A1,3))
&
=(2019+INT(A1/1000)&"-12-31")+MOD(A1,1000)


This doesn't really solve your situation though where you have the 4 digit date and a time stamp.

With that being said, I have created a user defined function (UDF) that you can copy into a regular module and use in a cell formula to get the results that you mentioned that you wanted to see.

Public Function Julian(JulianDateString As String)
'
''    Dim ConvertedDate           As Date
    Dim CalenderDays            As Long
    Dim CalenderYear            As Long
    Dim ConvertedDateSerial     As Long
    Dim ConvertedDateFormatted  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 Date ... 11/22/2021
'
    ConvertedDateSerial = CLng(DateSerial(CalenderYear, 1, CalenderDays))           ' Returns serial date ... 44522
    ConvertedDateFormatted = Format(ConvertedDateSerial, "d mmm yyyy")              ' Returns "22 Nov 2021"
'
    CombinedFormattedDateTime = ConvertedDateFormatted & Right(JulianDateString, 5) ' Returns "22 Nov 2021/2230"
'
    Julian = CombinedFormattedDateTime
End Function

The formula you would enter into a cell would be:

= julian(A1)

for example, where cell A1 contains one of your example strings such as '1326/2230'.

 

[Livin404]

Thank you I got that to work, It's getting me in the right direction. Is there a way I can get that without the "/"? Than I would need something to make the value an absolute value for I will have to subtract 5 hrs. to make the time local.

I think I can do that with this VBA.

Sub Subtract_Z_Hours()
    Dim Rng As Range
    For Each Rng In ActiveSheet.Range("F1", ActiveSheet.Cells(Rows.Count, 4).End(xlUp))
        Rng.NumberFormat = "dd mmm yyyy hhmm"
        If IsNumeric(Rng) Then
            Rng.Value = Rng.Value - TimeSerial(8, 0, 0)
        Else
            Rng.Value = CDate(Application.Replace(Rng, Len(Rng) - 1, 0, ":")) - TimeSerial(5, 0, 0)
        End If
    Next Rng
End Sub

Thank you,

 

[johnnyL]

Sorry change the following to get rid of the '/':

    CombinedFormattedDateTime = ConvertedDateFormatted & Right(JulianDateString, 5) ' Returns "22 Nov 2021/2230"
'
    Julian = CombinedFormattedDateTime
End Function

to the following:

    CombinedFormattedDateTime = ConvertedDateFormatted & " " & Right(JulianDateString, 4) ' Returns "22 Nov 2021 2230"
'
    Julian = CombinedFormattedDateTime
End Function

Are you now saying that you want to convert the last 4 digits of your string?

 

[Livin404]

Sorry change the following to get rid of the '/':

    CombinedFormattedDateTime = ConvertedDateFormatted & Right(JulianDateString, 5) ' Returns "22 Nov 2021/2230"
'
    Julian = CombinedFormattedDateTime
End Function

to the following:

    CombinedFormattedDateTime = ConvertedDateFormatted & " " & Right(JulianDateString, 4) ' Returns "22 Nov 2021 2230"
'
    Julian = CombinedFormattedDateTime
End Function

Are you now saying that you want to convert the last 4 digits of your string?

Yes, I didn't bring it up because I figured I better complete my first objected which is to convert the numbers to "12 May 2022 2230" type of format which yours did. From there I thought
I could use the VBA code:

Sub Subtract_Z_Hours()
    Dim Rng As Range
    For Each Rng In ActiveSheet.Range("F1", ActiveSheet.Cells(Rows.Count, 4).End(xlUp))
        Rng.NumberFormat = "dd mmm yyyy hhmm"
        If IsNumeric(Rng) Then
            Rng.Value = Rng.Value - TimeSerial(8, 0, 0)
        Else
            Rng.Value = CDate(Application.Replace(Rng, Len(Rng) - 1, 0, ":")) - TimeSerial(5, 0, 0)
        End If
    Next Rng
End Sub

This code get me the local time Zulu minus 5 hours equals local time and adjust the day if a day is subtracted because of the time difference.

Thank you,

 

[johnnyL]

So are you good now?

 

[johnnyL]

No response so here you go:

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

All in one, convert to date and time - 5 hours.

 

[Livin404]

No response so here you go:

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

All in one, convert to date and time - 5 hours.

Thank you so much, that works brilliantly, the only thing I had to do was create another macro to input the formula in the cells and it is spot on. The formula I used was

Sub Georgian()
Range("G1").Formula = "= julian(F1)"
Range("G1", "G" & Cells(Rows.Count, 1).End(xlUp).Row).FillDown
End Sub

Then I copy and pasted Value with a VBA

Sub Copy_Paste()
Range("G1", "G" & Cells(Rows.Count, 1).End(xlUp).Row).Copy
Range("G1", "G" & Cells(Rows.Count, 1).End(xlUp).Row).PasteSpecial Paste:=xlPasteValues
End Sub

Lastly I deleted Column F and ended up exactly what I needed.

Sub GDSSS_TIME()
        Dim sourceSheet As Worksheet
        Set sourceSheet = Sheet1
     sourceSheet.Range("F:F").EntireColumn.Delete
    End Sub

You were a great help for sure.

 

[johnnyL]

How about:

Sub CopyJulianUDFFormulas_Calculate_DeleteJulianFormulas_DeleteOriginalJulianDataColumn()
'
    Range("G1").Formula = "= julian(F1)"                                                        ' Copy formula to cell
    Range("G1").AutoFill Destination:=Range("G1:G" & Range("F" & Rows.Count).End(xlUp).Row)     ' Copy Formula down the range
'
    With Range("G1:G" & Range("F" & Rows.Count).End(xlUp).Row)                                  ' Loop through the formula column
        .Value = .Value                                                                         '   Remove formulas from cell leaving just the value
    End With
'
    Range("F:F").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(F1) where F1 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)                                                                      ' Get/Save left 4 characters from JulianDateString
    CalenderDays = CLng(Right(JulianDate, 3))                                                                   ' Get/Save last 3 of 4 characters from JulianDate
'
    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

 

[Livin404]

Thank you so much! I was able to cut three Macros. I like to think I had the basic concept, you're just streamlining things for me. There is one last component of the times I'm trying to sort out. It's basically a flight schedule. After I cut and paste from a website the schedule and I run it. I will need this to pick up any dates that are missing. I'm quite confident this VBA will work.

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

The good news I have for example "22 Nov 2021 1730" in Column E, and it's the same in the Formula Bar. It also states that it is in a "General Format". I think I need a custom format and it to read the same in the cells but in the formula bar it to be "11/22/2021 5:30:00 PM". I'm just confused because in the Macro "Public Function Julian(JulianDateString As String) " you describe the format.

TimePortion = TimeValue(Left(Right(JulianDateString, 4), 2) & ":" & Right(Right(JulianDateString, 4), 2))
JulianFinalResult = Format(ConvertedDate + TimePortion - TimeSerial(5, 0, 0), "dd mmm yyyy hhmm")

Do you think I need another ":" in the "Public Function..." micro"?