Regular Date to Julian Converter
Copy and paste the text in the box into the visual basic editor that comes with Excel. To get access to personal.xls in the visual basic editor check out this article: Save_Macros_in_Excel
This short program takes date & time cells and converts it to Julian days. An additional option is a Julian Decimal day, which converts the time into a decimal quantity. There are several important parameters you may need to edit to get things working specifically these:
startrow = 13 outcol = 1 datecol = 2 Worksheetz = 1 decimalday = True
startrow -- this is the starting row, the first line in the excel worksheet there is a date to be converted from Julian to regular.
outcol -- this is the output column, the column you want the resulting date to be put into. A = 1, B = 2 etc.
datecol -- this is the column the Time & Date are in
Worksheetz -- this is the excel worksheet number of the data you wish to calculate dates for. If you have a mix of charts and worksheets in your excel file worksheet #1 is treated as the leftmost worksheet on the bar along the bottom of the spreadsheet.
decimalday -- this boolean variable (True/False) tells the macro whether to output decimal days (as is done for some north slope sites) or an integer julian day.
Well, with that all out of the way, here's the program. Get a hold of Bob Busey if you have any questions or problems running this.
Option Explicit
Public Sub Convert_To_Julian()
Dim row As Long
Dim startrow As Long
Dim theyear As Double
Dim themonth As Double
Dim theday As Double
Dim thehour As Double
Dim theminute As Double
Dim thedate As String
Dim tempstring1() As String
Dim tempstring2() As String
Dim leapyear As Integer
Dim julianday As Double
Dim Worksheetz As Integer
Dim outcol As Integer
Dim datecol As Integer
Dim decimalday As Boolean
'''''''''''''''''''''
' variable initialization '
'''''''''''''''''''''
startrow = 13
outcol = 1
datecol = 2
Worksheetz = 1
note this decimal day.. If decimalday = true then hours & minutes will be tacked on
if decimalday = false then the julian day will be an integer.
decimalday = True
'''''''''''''''''''''
row = startrow
Do While Worksheets(Worksheetz).Cells(row, datecol).Value <> ""
' Run through and pull the time/date from the spreadsheet
thedate = Worksheets(Worksheetz).Cells(row, datecol).Value
' separate out the date & time components individually
tempstring1 = Split(Format(thedate, "mm/dd/yyyy"), "/")
tempstring2 = Split(Format(thedate, "hh:mm"), ":")
themonth = CDbl(tempstring1(0))
theday = CDbl(tempstring1(1))
theyear = CDbl(tempstring1(2))
thehour = CDbl(tempstring2(0))
theminute = CDbl(tempstring2(1))
' use the year to check for the need for a leap day
If theyear Mod 4 = 0 Then
leapyear = 1
Else
leapyear = 0
End If
' Do the Julian Day calculations
If themonth = 1 Then ' JANUARY
julianday = theday
ElseIf themonth = 2 Then ' FEBRUARY
julianday = theday + 31
ElseIf themonth = 3 Then ' MARCH
julianday = theday + 31 + 28 + leapyear
ElseIf themonth = 4 Then ' APRIL
julianday = theday + 31 + 28 + leapyear + 31
ElseIf themonth = 5 Then ' MAY
julianday = theday + 31 + 28 + leapyear + 31 + 30
ElseIf themonth = 6 Then ' JUNE
julianday = theday + 31 + 28 + leapyear + 31 + 30 + 31
ElseIf themonth = 7 Then ' JULY
julianday = theday + 31 + 28 + leapyear + 31 + 30 + 31 + 30
ElseIf themonth = 8 Then ' AUGUST
julianday = theday + 31 + 28 + leapyear + 31 + 30 + 31 + 30 + 31
ElseIf themonth = 9 Then ' SEPTEMBER
julianday = theday + 31 + 28 + leapyear + 31 + 30 + 31 + 30 + 31 + 31
ElseIf themonth = 10 Then ' OCTOBER
julianday = theday + 31 + 28 + leapyear + 31 + 30 + 31 + 30 + 31 + 31 + 30
ElseIf themonth = 11 Then ' NOVEMBER
julianday = theday + 31 + 28 + leapyear + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31
ElseIf themonth = 12 Then ' DECEMBER
julianday = theday + 31 + 28 + leapyear + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31 + 30
End If
If we need decimal days then add the decimal part here.
If decimalday = True Then
julianday = julianday + thehour / 24 + theminute / 24 / 60
End If
ready to output back to the original spreadsheet.
Worksheets(Worksheetz).Cells(row, outcol).Value = julianday
Go to the next row.
row = row + 1
Loop
Range("A" & CStr(startrow)).Select
End Sub