Toggle a range of Julian dates to Gregorian Dates and Back

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,
--

Patrick

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

--
**** Kusleika
Excel MVP
Daily Dose of Excel
www.*****-blog.com

PSKelligan wrote:
> 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,

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

--
**** Kusleika
Excel MVP
Daily Dose of Excel
www.*****-blog.com

**** Kusleika wrote:
> 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
>
>
> PSKelligan wrote:
>> 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,

****,

Works perfectly! Thanks for the assist.

V/R,
Patrick

"**** Kusleika" wrote:

> 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
>
> --
> **** Kusleika
> Excel MVP
> Daily Dose of Excel
> www.*****-blog.com