Transforming date ranges into discrete dates
 

I would like to transform the following type of file format:

Person Event Start Stop
1 1 1/1/03 1/2/03
1 2 1/7/03 1/9/03
1 3 2/1/03 2/2/03
2 1 3/1/03 3/3/03
etc...

Into a format in which each date in each range, inclusive of the
boundaries, is represented.
Person Event Date
1 1 1/1/03
1 1 1/2/03
1 2 1/7/03
1 2 1/8/03
1 2 1/9/03
1 3 2/1/03
1 3 2/2/03
2 1 3/1/03
2 1 3/2/03
2 1 3/3/03
etc...

This is something I would want to do each time I opened the worksheet. The source data come from an Access database; hence, the # rows per person, and the number of persons per worksheet, are not fixed (i.e., would not necessarily be the same each time I do this transformation). I've being trying to write a custom function to return an array, but so far have been unsuccessful (I've not written custom functions before). Perhaps this is not the best approach...

Any help would be greatly appreciated. Thanks in advance.

Transforming date ranges into discrete dates
 

The following macro will copy the records onto sheet2, with a separate
row for each date:

'===================================
Sub TransformDates()
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim c As Range
Dim i As Integer
Dim r As Long
Dim r2 As Long

Set ws = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
r = ws.Cells(Rows.Count, 1).End(xlUp).Row

ws2.Cells(1, 1).Value = "Person"
ws2.Cells(1, 2).Value = "Event"
ws2.Cells(1, 3).Value = "Date"

For Each c In ws.Range(ws.Cells(2, 1), ws.Cells(r, 1))
i = c.Offset(0, 3) - c.Offset(0, 2) + 1
For i = 1 To i
r2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1
c.Resize(1, 2).Copy Destination:=ws2.Cells(r2, 1)
ws2.Cells(r2, 3).Value = c.Offset(0, 2) + i - 1
Next i
Next c
End Sub
'====================================

Tracy H wrote:
I would like to transform the following type of file format:

Person Event Start Stop
1 1 1/1/03 1/2/03
1 2 1/7/03 1/9/03
1 3 2/1/03 2/2/03
2 1 3/1/03 3/3/03
etc...

Into a format in which each date in each range, inclusive of the
boundaries, is represented.
Person Event Date
1 1 1/1/03
1 1 1/2/03
1 2 1/7/03
1 2 1/8/03
1 2 1/9/03
1 3 2/1/03
1 3 2/2/03
2 1 3/1/03
2 1 3/2/03
2 1 3/3/03
etc...

This is something I would want to do each time I opened the worksheet. The source data come from an Access database; hence, the # rows per person, and the number of persons per worksheet, are not fixed (i.e., would not necessarily be the same each time I do this transformation). I've being trying to write a custom function to return an array, but so far have been unsuccessful (I've not written custom functions before). Perhaps this is not the best approach...

Any help would be greatly appreciated. Thanks in advance.



--
Debra Dalgleish
Excel FAQ, Tips & Book List
http://www.contextures.com/tiptech.html

Transforming date ranges into discrete dates
 

Debra

Thanks for prompt reply

When I run this macro (from the Tools Menu), I get an error 'Runtime error(13) type mismatch' and when I click debug, it highlights this line
i = c.Offset(0, 3) - c.Offset(0, 2) +

I suspect I am just doing something wrong...I would greatly appreciate any suggestions

Tracy

Transforming date ranges into discrete dates
 

Because you're importing the data from Access, the dates are probably
being treated as text. Add the CDate function to convert the text to
dates. I've also added a line to clear sheet2 before running the rest of
the code:

'=========================
Sub TransformDates()
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim c As Range
Dim i As Integer
Dim r As Long
Dim r2 As Long

Set ws = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
r = ws.Cells(Rows.Count, 1).End(xlUp).Row

ws2.Cells.Clear
ws2.Cells(1, 1).Value = "Person"
ws2.Cells(1, 2).Value = "Event"
ws2.Cells(1, 3).Value = "Date"

For Each c In ws.Range(ws.Cells(2, 1), ws.Cells(r, 1))
i = CDate(c.Offset(0, 3)) - CDate(c.Offset(0, 2)) + 1
For i = 1 To i
r2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1
c.Resize(1, 2).Copy Destination:=ws2.Cells(r2, 1)
ws2.Cells(r2, 3).Value = CDate(c.Offset(0, 2)) + i - 1
Next i
Next c
End Sub
'============================

Tracy H wrote:
Debra,

Thanks for prompt reply!

When I run this macro (from the Tools Menu), I get an error 'Runtime error(13) type mismatch' and when I click debug, it highlights this line:
i = c.Offset(0, 3) - c.Offset(0, 2) + 1

I suspect I am just doing something wrong...I would greatly appreciate any suggestions.

Tracy


--
Debra Dalgleish
Excel FAQ, Tips & Book List
http://www.contextures.com/tiptech.html