Toggle a range of Julian dates to Gregorian Dates and Back

[PSKelligan]

Hello All!
*Excel 2003*

I have a 2 bits of code I coppied from Chip Pearsons Website that changes my
Julian dates to Gregorian dates and back again.

I have a Worksheet that I would like to use this code on but I would like it
to look at 2 columns ("D" and "I") that contain Julian dates ie.(04354)
formatted as text and run this function on the entire Used Range of both
columns (minus the Header row). As the functions loop through the ranges I
want to replace the old Julian values with the new Gregorian values. I will
then run some proceedures that include the Gregorian Dates and after I am
finished I wish to return them to their previous Julian Dates.

Basiclly I want the ability to toggle these date formats back and forth from
within other proceedures. Can anyone assist me with this code? My julian
date functions are posted below.

Function JDateToGDate1(JDate As String) As Long
Dim TheYear As Integer
Dim TheDay As Integer
Dim GDate As Long

TheYear = CInt(Left(JDate, 2))
If TheYear < 30 Then
TheYear = TheYear + 2000
Else
TheYear = TheYear + 1900
End If

TheDay = CInt(Right(JDate, 3))
GDate = DateSerial(TheYear, 1, TheDay)
JDateToGDate1 = GDate

End Function

'************** And**************

Function GDateToJDate1(GDate As Long) As String
Dim TheYear As Integer
Dim TheDays As Integer
Dim JDate As String

TheYear = Year(GDate)
TheDays = DateDiff("d", DateSerial(TheYear, 1, 0), GDate)
JDate = Right(Format(TheYear, "0000"), 2) & Format(TheDays, "000")
GDateToJDate1 = JDate

End Function


Thanks in advance for your assistance,

 

[Dick Kusleika]

PS

This will convert TO Julian. Make an identical sub and change the function
to convert FROM Julian

Sub ToggleJ()

Dim rCell As Range
Dim rRange As Range

With ActiveSheet
Set rRange = Intersect(.UsedRange, Union(.Columns("D"),
..Columns("I")))
Set rRange = rRange.Offset(1).Resize(rRange.Rows.Count - 1)
End With

For Each rCell In rRange.Cells
rCell.Value = GDateToJDate1(rCell.Value)
Next rCell

End Sub

 

[Dick Kusleika]

PS

Scratch that. I guess Resize doesn't work well with Areas. Change to this

Sub ToggleJ()

Dim rCell As Range
Dim rRange As Range

With ActiveSheet
Set rRange = Intersect(.UsedRange, Union(.Columns("D"),
..Columns("I")))
Set rRange = rRange.Offset(1)
End With

For Each rCell In rRange.Cells
If Not IsEmpty(rCell.Value) Then
rCell.Value = GDateToJDate1(rCell.Value)
End If
Next rCell

End Sub

 

[PSKelligan]

Dick,

Works perfectly! Thanks for the assist.

V/R,
Patrick

 

[Ienidualc]

Dear friend.
What do you think to put in GDate in
" Function GDateToJDate1(GDate As Long) As String" ?
because GDate is a long if you put exemple 12/04/2007 will be error.

Give a exemple.