macro for adding rows after range of dates

[Guest]

OK here's the problem:

I have a list of data with dates in column C.

I want to systematically insert two rows for every 7 days worth of data.
Here comes the tricky part...

There probably won't ACTUALLY be 7 days worth of data, there may only be 4
days or 5 days or however many days. I want it to look for a range of 7 day
periods and insert two rows between the records within the range.

Below is an example of what the data would look like before the macro.

A B C D E F G
10039999 Joe Smith 8/29/2003 Regular 7.5 10.06 75.45
10039999 Joe Smith 8/29/2003 Overtime 4.1 15.24 62.48
10039999 Joe Smith 8/30/2003 Regular 7.5 12.73 95.48
10039999 Joe Smith 9/1/2003 Holiday 7.5 12.73 95.48
10039999 Joe Smith 9/9/2003 Regular 7.5 12.73 95.48
10039999 Joe Smith 9/12/2003 Regular 7.5 12.73 95.48
10039999 Joe Smith 9/16/2003 Regular 3.5 12.73 44.56

So after the 7 day period of 8/24/03 - 8/30/03 it should insert two rows.
After the 7 day period of 8/31/03 - 9/6/03 it should insert two rows. After
the 7 day period of 9/7/03 - 9/13/03 it should insert two rows and so on.

Here's what it should look like after:
A B C D E F G
10039999 Joe Smith 8/29/2003 Regular 7.5 10.06 75.45
10039999 Joe Smith 8/29/2003 Overtime 4.1 15.24 62.48
10039999 Joe Smith 8/30/2003 Regular 7.5 12.73 95.48


10039999 Joe Smith 9/1/2003 Holiday 7.5 12.73 95.48


10039999 Joe Smith 9/9/2003 Regular 7.5 12.73 95.48
10039999 Joe Smith 9/12/2003 Regular 7.5 12.73 95.48


10039999 Joe Smith 9/16/2003 Regular 3.5 12.73 44.56

I hope this is explained clearly enough. Thanks in advance, you all are the
best!

 

[Frank Kabel]

Hi
1. Set a reference to the Analysis Toolpak addin in the VBE editor
('Tools - References')
2. Try the following macro

Sub insert_rows()
Dim lastrow As Long
Dim row_index As Long

lastrow = ActiveSheet.Cells(Rows.count, "D").End(xlUp).row
For row_index = lastrow - 1 To 1 Step -1
If weeknum(Cells(row_index, "D").Value) <> _
weeknum(Cells(row_index + 1, "D).Value) Then
Cells(row_index + 1, "D).EntireRow.Insert (xlShiftDown)
End If
Next
End Sub

 

[Guest]

I don't see the Analysis Toolpak addin under the references for the VBE
editor....Any ideas?

 

[Guest]

OK I found the Addin but it gives me a type mismatch error when I run it and
it only inserts 1 row between the sections. Other than that it works great!

 

[Frank Kabel]

Hi
it is named
atpvbaen
in this list

 

[Frank Kabel]

Hi
for inserting two rows try changing
Cells(row_index + 1, "D").EntireRow.Insert (xlShiftDown)
to
Cells(row_index + 1, "D").resize(2,1).EntireRow.Insert (xlShiftDown)

 

[Myrna Larson]

Hi, Frank:

I spotted two places where you had "D instead of "D".

 

[Guest]

awesome!

Ok now how do I add text into one of the inserted rows? The text should be
the Saturday date of each period mentioned below so in the first cell of the
inserted row it should say:

Week Ending 8/30/03

Then

Week Ending 9/6/03

And so on.

 

[Frank Kabel]

Hi Myrna
probably getting too late over here )
thanks for the spot!

 

[Frank Kabel]

Hi
try:
Sub insert_rows()
Dim lastrow As Long
Dim row_index As Long
Dim enddat as date

lastrow = ActiveSheet.Cells(Rows.count, "D").End(xlUp).row
For row_index = lastrow - 1 To 1 Step -1
If weeknum(Cells(row_index, "D").Value) <> _
weeknum(Cells(row_index + 1, "D").Value) Then
enddat=Cells(row_index, "D").Value+(7 - _
application.worksheetfunction.weekday( _
Cells(row_index, "D").Value)
Cells(row_index + 1, "D").resize(2,1).EntireRow.Insert
(xlShiftDown)
cells(row_index+1,"A").value="Week ending at " &
format(enddat,"MM/DD/YYYY")
End If
Next
End Sub

 

[Frank Kabel]

Hi
sorry, typo. Use:
Sub insert_rows()
Dim lastrow As Long
Dim row_index As Long
Dim enddat as date

lastrow = ActiveSheet.Cells(Rows.count, "D").End(xlUp).row
For row_index = lastrow - 1 To 1 Step -1
If weeknum(Cells(row_index, "D").Value) <> _
weeknum(Cells(row_index + 1, "D").Value) Then
enddat=Cells(row_index, "D").Value+ 7 - _
application.worksheetfunction.weekday( _
Cells(row_index, "D").Value)
Cells(row_index + 1, "D").resize(2,1).EntireRow.Insert
(xlShiftDown)
cells(row_index+1,"A").value="Week ending at " &
format(enddat,"MM/DD/YYYY")
End If
Next
End Sub

 

[Guest]

you're incredible!

OK one more thing to add....
Can an AutoSum added to the 6th (F) and 8th (H) cell of the inserted row?
to be on the same line as the inserted text from before?

Can the line with text be made bold?

My department is immensely thankful, this is going to be such a huge
timesaver for us....

 

[Frank Kabel]

Hi
more and more
try the following macro (not tested):
Sub insert_rows()
Dim lastrow As Long
Dim row_index As Long
Dim enddat as date

lastrow = ActiveSheet.Cells(Rows.count, "D").End(xlUp).row
For row_index = lastrow - 1 To 1 Step -1
If weeknum(Cells(row_index, "D").Value) <> _
weeknum(Cells(row_index + 1, "D").Value) Then
enddat=Cells(row_index, "D").Value+ 7 - _
application.worksheetfunction.weekday( _
Cells(row_index, "D").Value)
Cells(row_index + 1, "D").resize(2,1).EntireRow.Insert _
(xlShiftDown)
cells(row_index+1,"A").value="Week ending at " & _
format(enddat,"MM/DD/YYYY")
cells(row_index+1,"F").formula= _
"SUMPRODUCT(--($D$1:$D$1000<=" & enddat & _
"),--($D$1:$D$1000>=" & enddat-7 & "),$F$1:$F$1000)"
cells(row_index+1,"H").formula= _
"SUMPRODUCT(--($D$1:$D$1000<=" & enddat & _
"),--($D$1:$D$1000>=" & enddat-7 & "),$H$1:$H$1000)"
cells(row_index+1,"A").entirerow.font.bold=true

End If
Next
End Sub