Code to Extract and Concatenate D/M/Y from Column of Julian Dates

**anthony19** · 06-13-2012, 11:02 AM

Hello.

Working on a simple part of code but having trouble.

Have a list of Julian dates in a column and would like to write a loop to go through each, identify the year, month and day with the respective functions, and then concatenate the results into a certain form.

Having a bunch of problems and would appreciate help with any.

1. Currently using this line
Do Until IsEmpty(Range("A3:A").Offset(i.0))
to move down the column - is there any need for .End(xlDown) somewhere here?

2. Am not sure how to initiate a counter to go down through - have something like this for now:
For i=0 to 9
ActiveCell.Offset(i,1)=Y
ActiveCell.Offset(i,2)=M
Next i

3. Finally after I eventually clear those hurdles, do not know how to concatenate the variables properly: Y&M&D do not seem to work.

Thanks!

**tkowal** · 06-13-2012, 11:50 AM

Sending an example workbook with what you have so far and some representative data would go a long way in getting some help

Without any code you can convert a Julian Date to a Standard Date? The formula below will convert a Julian Date in Cell A1 to Standard Date

In B1 put this formula:
=DATE(IF(0+(LEFT(A1,2))<30,2000,1900)+LEFT(A1,2),1,RIGHT(A1,3))

**anthony19** · 06-13-2012, 11:55 AM

Yes I saw such formulas when searching earlier but this is an intermediary step before concatenating the Y, M, D into a specific format (namely, YYYYMMDD).

Here is the disastrous bits of code I have so far!

Sub DateExtract()

Dim Y As Long
Dim M As Long
Dim D As Long
Dim TestDate As String
Dim i As Integer
'Dim counter As Integer

'Sheets("Series").Range ("A3:A200")
'Do While Not IsEmpty(ActiveCell.Offset(1, 0))

Do Until IsEmpty(Range("A3:A").Offset(i, 0))
'Range(ActiveCell, ActiveCell.End(xlDown))

Y = year(ActiveCell)
M = Month(ActiveCell)
D = Day(ActiveCell)

For i = 0 To 9
ActiveCell.Offset(i, 1) = Y
ActiveCell.Offset(i, 2) = M
ActiveCell.Offset(i, 3) = D
Next i
Loop

'TestDate = "Y&M&D"

End Sub

'Exit Do
'Loop Until IsEmpty(ActiveCell)
'Cells.Range(A3,A50)IsEmpty=False
'IsEmpty(ActiveCell) = False
'ActiveCell.Offset(0,1,)=year(ActiveCell)

**tkowal** · 06-13-2012, 03:14 PM

Again, upload a sample workbook -- not knowing the context of the data does not help in interpreting your code.

Observations:

1. Do not see any "Intermediate Step" -- Formula given in earlier post will work.....
2. Statement Do Until IsEmpty(Range("A3:A").Offset(i,0) Your incremental is never increased. In fact you are reusing the counter in your for loop "For i=0 to 9" This is bad coding practice.... in fact after your first run where i = 0 , then is stays 9 for an end less loop inside the Do statement
3. Your VBA code does not convert Julian Dates

Not knowing your structure the code would look something like this: I have attatched a workbook with the code as well as doing the same using formulas....

JulianDates.xlsm

Sub ConvertJulianDates()
Dim i As Integer
Dim r As Range
Dim JulianDate As Long
Dim SerialDate As Date
Dim JR As Long

Set r = Range("A3")
i = 0   'Starting Counter
Do Until IsEmpty(r.Offset(i, 0).Value)
   JulianDate = Val(r.Offset(i, 0).Value)
   If Left(JulianDate, 2) < 30 Then
      JR = 2000
   Else
      JR = 1900
   End If
   SerialDate = DateSerial(JR + Int(JulianDate / 1000), 1, JulianDate Mod 1000)
   r.Offset(i, 1).Value = Year(SerialDate)
   r.Offset(i, 2).Value = Month(SerialDate)
   r.Offset(i, 3).Value = Day(SerialDate)
   i = i + 1
Loop
End Sub