Excel Stat and End Date - Duplicate for Each Day

I have an excel file that lists events, one per row, with start and end dates. I want to duplicate the individual rows to have a row for each day the event occurred. i.e. the event is for July 1 - July 3, I want to replicate the row for each day so I can run some analysis.

Thanks
bezellviAsked:
Who is Participating?
 
Rob HensonConnect With a Mentor Finance AnalystCommented:
Try this file, maybe copying code over didn't work properly.

Thanks
Rob H
Events.xlsm
0
 
Rob HensonFinance AnalystCommented:
So for the example event provided, create an additional two rows and populate with the event data from above.

Or do you want a row for 1 July, row for 2 July and a row for 3 July?

I have a routine that I can tweak for the first option.

I will take a look and upload, in the meantime can you upload some sample data to play with.

Thanks
Rob H
0
 
bezellviAuthor Commented:
Thanks - I understand how to do it for a row at a time, but I have a year's worth of data - I was hoping to automate it somehow.
0
Cloud Class® Course: Microsoft Windows 7 Basic

This introductory course to Windows 7 environment will teach you about working with the Windows operating system. You will learn about basic functions including start menu; the desktop; managing files, folders, and libraries.

 
bezellviAuthor Commented:
Here's some sample data
SampleData.xlsx
0
 
Rob HensonFinance AnalystCommented:
See attached.
Events.xlsm
0
 
Rob HensonFinance AnalystCommented:
Slight amendment to the code, I hadn't allowed for the extra columns from my sample that I put together.

Sub InsertRows()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Range("A2").Select
Do Until ActiveCell.Value = ""

    IR = ActiveCell.Value
    ActiveCell.Offset(1, 0).Range("A1:A" & IR).Select
    Selection.EntireRow.Insert
    Selection.End(xlUp).Select
    ActiveCell.Offset(0, 0).Range("A1:H" & IR + 1).Select
    Selection.FillDown
    ActiveCell.Offset(IR + 1, 0).Select
Loop
    
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Calculate

End Sub

Open in new window


Note change on line 13, .Range("A1:H"&IR + 1.Select

Thanks
Rob H
0
 
Rob HensonFinance AnalystCommented:
Hold fire on implementing, I hadn't allowed for only single day events.
0
 
andrew_manCommented:
I suggest to use pivot table
SampleData.xlsx
0
 
Rob HensonFinance AnalystCommented:
Updated version attached.

Assuming you need to implement this into a bigger file, insert column at left side of your proper file and insert formula:

=F2-E2 to work out number of days.

Then transfer the VBA code from my file; if you need help doing that, let me know.

Thanks
Rob H
Events.xlsm
0
 
andrew_manCommented:
The pivot table is more flexible for your case, but you need to know what you want.  Then, we can give you a best solution. (if needs)
0
 
Rob HensonFinance AnalystCommented:
Andrew_Man - how does a pivot table do what the user wants?

PT merely summarises or counts entries. User wants to duplicate entries.
0
 
andrew_manCommented:
Pivot table also can find out the duplicate entries.

By the way, excel have the function to remove the duplication.

Data->Remove Duplicates

But, it seems no duplicates
0
 
bezellviAuthor Commented:
I am trying to CREATE duplicates, not eliminate.
0
 
andrew_manCommented:
robhenson,

So, it is entirely up to the Asker to decide if the suggestion is good or bad.
0
 
Rob HensonFinance AnalystCommented:
My solution will create duplicates for you.

At the moment the lines are duplicated in their entirety. There is still one question I asked at the beginning which is not answered. For each event line do you want the range of dates to stay as the whole event or changed to represent only one day?

For example, Event in question is 1 July to 3 July. Do you want a row for each day?

Row 1 Start 1 July Finish 1 July
Row 2 Start 2 July Finish 2 July
Row 3 Start 3 July Finish 3 July

OR

Row 1 Start 1 July Finish 3 July
Row 2 Start 1 July Finish 3 July
Row 3 Start 1 July Finish 3 July

Thanks
Rob H
0
 
andrew_manCommented:
Dear Bezelivi,

What is the pattern of the created duplicates?

Andrew
0
 
bezellviAuthor Commented:
I want a row for each day
0
 
andrew_manCommented:
Sub Insert_Blank_Rows()
     
    Selection.End(xlDown).Select
     
    Do Until ActiveCell.Row = 1
         'Insert blank row.
        ActiveCell.EntireRow.Insert shift:=xlDown
         'Move up one row.
        ActiveCell.Offset(-1, 0).Select
    Loop
     
End Sub
0
 
Rob HensonFinance AnalystCommented:
Andrew_Man

Thats what my script does.

However, it also copies the details from the row above, creating the duplicate as required rather than just inserting a blank row.

Yours just creates one blank row per entry in original list. User wants one entry per day of event. So event of 3 days would have 3 rows (original plus 2 duplicates). Event lasting only 1 day would stay with only 1 row.
0
 
bezellviAuthor Commented:
robhenson - this is great, but I need the Start date to advance to the actual date of the new day... so for example, an event that is July 9 - July 12, I need it to duplicate for a total of 4 rows, then the start dates should be July 9, July 10, July 11 and July 12. Make sense?
0
 
Rob HensonFinance AnalystCommented:
Yes that makes sense, thats what I was asking earlier; if you wanted new dates for each row.

What about the finish dates? Stay as original or become same as start? Other?

Thanks
Rob
0
 
bezellviAuthor Commented:
The finish dates can stay as is - that field will become less relevant when I pivot the new data. Thanks!!!
0
 
Rob HensonFinance AnalystCommented:
Updated script for you, additional lines in bold:

Sub InsertRows()

'Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual

Range("A2").Select
Do Until ActiveCell.Value = ""

    IR = ActiveCell.Value
    If IR = 0 Then
    ActiveCell.Offset(1, 0).Select
    Else
    ActiveCell.Offset(1, 0).Range("A1:A" & IR).Select
    Selection.EntireRow.Insert
    Selection.End(xlUp).Select
    ActiveCell.Offset(0, 0).Range("A1:H" & IR + 1).Select
    Selection.FillDown
    [b]CR = ActiveCell.Row
    For DateAdj = 1 To IR
    Cells(CR + DateAdj, 5) = Cells(CR + DateAdj, 5) + DateAdj
    Cells(CR + DateAdj, 6) = Cells(CR + DateAdj, 5)
    Next DateAdj[/b]
    
    ActiveCell.Offset(IR + 1, 0).Select
    End If
Loop
    
'Application.ScreenUpdating = True
'Application.Calculation = xlCalculationAutomatic
'Calculate

End Sub

Open in new window

Line 21 can be deleted or commented out if you don't want finish dates changed. It doesn't change the finish date on first row anyway.

Thanks
Rob H
0
 
Rob HensonFinance AnalystCommented:
Bold highlighting didn't work, lines 18 to 22 are new lines but you don't need the and tags.
0
 
Rob HensonFinance AnalystCommented:
The bold highlight worked that time eventhough I didn't want it to. Lines 18 to 22 should only be:

CR = ActiveCell.Row
For DateAdj = 1 To IR
Cells(CR + DateAdj, 5) = Cells(CR + DateAdj, 5) + DateAdj
Cells(CR + DateAdj, 6) = Cells(CR + DateAdj, 5)
Next DateAdj

Open in new window

Thanks
Rob H
0
 
bezellviAuthor Commented:
I am getting a Run-time error 13 type mismatch when I run the new code on the workbook you sent back.
0
 
Rob HensonFinance AnalystCommented:
Was your comment at 17:17 before I realised the Bold tags hadn't worked properly so the code copied had the bolds tags in it as well?
0
 
bezellviAuthor Commented:
Perfect!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.