I need to create rows of data based on days of the week. I start with a
calendar date and delete rows for days of the week where there are no
records. I need to now insert rows based on the remaining days of the week.

Specifically, on Wednesdays, I need to insert 1 row and copy cells from the
row above. On Thursdays and Fridays, I need to insert 3 rows and copy the
respective cells from each day. On Saturdays, I need to insert 4 rows and
copy the cells for Saturday.

This needs to go through the entire data set for one month or two months.
Any ideas?

Hi,

Try this which determines day of week from date and inserts/copies
accordingly

HTH

Sub InsertandCopy()

Dim ws1 As Worksheet
Dim r As Long, Lastrow As Long

' Number of inserts for Sunday to Saturday ....
nInserts = Array(0, 0, 0, 1, 3, 3, 4, 0)

Set ws1 = Worksheets("Sheet1")

With ws1

Lastrow = .Cells(Rows.Count, 1).End(xlUp).Row

For r = Lastrow To 2 Step -1
n = nInserts(Weekday(Cells(r, 1)) - 1)
If n < 0 Then
.Rows(r + 1).Resize(n).Insert Shift:=xlDown
.Rows(r).Copy .Rows(r + 1).Resize(n)
End If
Next r

End With

End Sub


"D Hafer - TFE" wrote:

I need to create rows of data based on days of the week. I start with a
calendar date and delete rows for days of the week where there are no
records. I need to now insert rows based on the remaining days of the week.

Specifically, on Wednesdays, I need to insert 1 row and copy cells from the
row above. On Thursdays and Fridays, I need to insert 3 rows and copy the
respective cells from each day. On Saturdays, I need to insert 4 rows and
copy the cells for Saturday.

This needs to go through the entire data set for one month or two months.
Any ideas?

Thank you! That worked perfectly!


"Toppers" wrote:

Hi,

Try this which determines day of week from date and inserts/copies
accordingly

HTH

Sub InsertandCopy()

Dim ws1 As Worksheet
Dim r As Long, Lastrow As Long

' Number of inserts for Sunday to Saturday ....
nInserts = Array(0, 0, 0, 1, 3, 3, 4, 0)

Set ws1 = Worksheets("Sheet1")

With ws1

Lastrow = .Cells(Rows.Count, 1).End(xlUp).Row

For r = Lastrow To 2 Step -1
n = nInserts(Weekday(Cells(r, 1)) - 1)
If n < 0 Then
.Rows(r + 1).Resize(n).Insert Shift:=xlDown
.Rows(r).Copy .Rows(r + 1).Resize(n)
End If
Next r

End With

End Sub


"D Hafer - TFE" wrote:

I need to create rows of data based on days of the week. I start with a
calendar date and delete rows for days of the week where there are no
records. I need to now insert rows based on the remaining days of the week.

Specifically, on Wednesdays, I need to insert 1 row and copy cells from the
row above. On Thursdays and Fridays, I need to insert 3 rows and copy the
respective cells from each day. On Saturdays, I need to insert 4 rows and
copy the cells for Saturday.

This needs to go through the entire data set for one month or two months.
Any ideas?