Excel Stat and End Date - Duplicate for Each Day

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

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.

Here's some sample data
SampleData.xlsx

See attached.
Events.xlsm

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

Select allOpen in new window

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

Thanks
Rob H

Hold fire on implementing, I hadn't allowed for only single day events.

I suggest to use pivot table
SampleData.xlsx

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

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)

Andrew_Man - how does a pivot table do what the user wants?

PT merely summarises or counts entries. User wants to duplicate entries.

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

I am trying to CREATE duplicates, not eliminate.

robhenson,

So, it is entirely up to the Asker to decide if the suggestion is good or bad.

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

Dear Bezelivi,

What is the pattern of the created duplicates?

Andrew

I want a row for each day

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

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.

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?

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

The finish dates can stay as is - that field will become less relevant when I pivot the new data. Thanks!!!

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

Select allOpen 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

Bold highlighting didn't work, lines 18 to 22 are new lines but you don't need the and tags.

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

Select allOpen in new window

Thanks
Rob H

I am getting a Run-time error 13 type mismatch when I run the new code on the workbook you sent back.

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?

Perfect!