Convert any Date Value to Julian Date Value

Category:

Dates and Math

Type:

Snippets

Difficulty:

Intermediate

Author:

Anonymous

Version Compatibility:

More information:

The Code can be used on any VB platform, since it uses basic VB functions, and is not dependent upon version specific code, i.e. functions only introduced in certain version of VB. (By the way, a Julian Date is defined as a serial number equal to the number of days elapsed since January 1, 4713 BCE).

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' (None)

Code:

'' ----------------------------------------------------------
'' Returns the Julian Date, for any valid date.
''
'' By: Joey Martin
'' 
'' Place this function in a Module, and use by passing 
'' a date.  Excellent for comparing two different dates.
'' I need to develope this code to compare to dates, 
'' to make sure that the from date and to dates in the search
'' query were correct, i.e. From < To .
'' 
'' example.
''
'' if ( JulianDate(D1) > JulianDate(D2)) then
''    
''    '' Do Something
'' End if

''  
''
Public Function JulianDate(ByVal datDate As Date) As Double
    Dim GGG
    Dim DD, MM, YY
    Dim S, A
    Dim JD, J1

Let MM = Month(datDate)
    Let DD = Day(datDate)
    Let YY = Year(datDate)
    Let GGG = 1
    
    If (YY <= 1585) Then
        GGG = 0
    End If
    
    Let JD = -1 * Int(7 * (Int((MM + 9) / 12) + YY) / 4)
    Let S = 1
    
    If ((MM - 9) < 0) Then
        S = -1
    End If
    
    Let A = Abs(MM - 9)
    Let J1 = Int(YY + S * Int(A / 7))
    Let J1 = -1 * Int((Int(J1 / 100) + 1) * 3 / 4)
    Let JD = JD + Int(275 * MM / 9) + DD + (GGG * J1)
    Let JD = JD + 1721027 + 2 * GGG + 367 * YY
    
    If ((DD = 0) And (MM = 0) And (YY = 0)) Then
      MsgBox "Please enter a meaningful date!"
    Else
      Let JulianDate = JD
    End If

End Function

'' ----------------------------------------------------------