Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
switch off transforming number into date | Excel Discussion (Misc queries) | |||
switch off transforming number into date | Excel Discussion (Misc queries) | |||
how can i networkdays date ranges where dates overlap | Excel Worksheet Functions | |||
How do I select the nearest date from a ranges of dates? | Excel Discussion (Misc queries) | |||
How do I count cells in a column of dates between date ranges? | Excel Worksheet Functions |