Deleting rows older than current date and inserting a new row

I have a workbook which contains a worksheet that has project data, including
project end date. Users update the sheet with current and projected
projects. I have written a macro to remove entries whose end date (in column
"G") are older than the current date.

The macro as written works, however when I run the macro it inserts a blank
row for every project listed in the spreadsheet. How do I get it to insert a
new row only when it deletes a row? And how do I make sure that the new,
inserted row is at the bottom of the formatted data (which ends at row 31)?

Sub DeleteOldRows()
Dim LastRow As Long, xR As Long
With ActiveSheet
LastRow = .Cells(Rows.Count, "G").End(xlUp).Row
For xR = LastRow To 6 Step -1
If .Cells(xR, "G") < Date Then _
Rows(xR).EntireRow.Delete
Rows(31).EntireRow.Insert
Next xR
End With

End Sub

Thanks for your help!

Dan,

Change

If .Cells(xR, "G") < Date Then _
Rows(xR).EntireRow.Delete
Rows(31).EntireRow.Insert

to

If .Cells(xR, "G") < Date Then
Rows(xR).EntireRow.Delete
Rows(31).EntireRow.Insert
end if


HTH,
Bernie
MS Excel MVP


"Dan E." <[email protected]> wrote in message
news:[email protected]...
>I have a workbook which contains a worksheet that has project data, including
> project end date. Users update the sheet with current and projected
> projects. I have written a macro to remove entries whose end date (in column
> "G") are older than the current date.
>
> The macro as written works, however when I run the macro it inserts a blank
> row for every project listed in the spreadsheet. How do I get it to insert a
> new row only when it deletes a row? And how do I make sure that the new,
> inserted row is at the bottom of the formatted data (which ends at row 31)?
>
> Sub DeleteOldRows()
> Dim LastRow As Long, xR As Long
> With ActiveSheet
> LastRow = .Cells(Rows.Count, "G").End(xlUp).Row
> For xR = LastRow To 6 Step -1
> If .Cells(xR, "G") < Date Then _
> Rows(xR).EntireRow.Delete
> Rows(31).EntireRow.Insert
> Next xR
> End With
>
> End Sub
>
> Thanks for your help!

Bernie - did as suggested, now it will not add additional rows. It deletes
fine, but the add command doesn't seem to be executed.

OK, updated code:

Sub DeleteOldRows()
Dim LastRow As Long, xR As Long
With ActiveSheet
LastRow = .Cells(Rows.Count, "G").End(xlUp).Row
For xR = LastRow To 6 Step -1
If .Cells(xR, "G") < Date Then
Rows(xR).EntireRow.Delete
Rows(31).EntireRow.Insert
End If
Next xR
End With

End Sub


"Bernie Deitrick" wrote:

> Dan,
>
> Change
>
> If .Cells(xR, "G") < Date Then _
> Rows(xR).EntireRow.Delete
> Rows(31).EntireRow.Insert
>
> to
>
> If .Cells(xR, "G") < Date Then
> Rows(xR).EntireRow.Delete
> Rows(31).EntireRow.Insert
> end if
>
>
> HTH,
> Bernie
> MS Excel MVP
>
>
> "Dan E." <[email protected]> wrote in message
> news:[email protected]...
> >I have a workbook which contains a worksheet that has project data, including
> > project end date. Users update the sheet with current and projected
> > projects. I have written a macro to remove entries whose end date (in column
> > "G") are older than the current date.
> >
> > The macro as written works, however when I run the macro it inserts a blank
> > row for every project listed in the spreadsheet. How do I get it to insert a
> > new row only when it deletes a row? And how do I make sure that the new,
> > inserted row is at the bottom of the formatted data (which ends at row 31)?
> >
> > Sub DeleteOldRows()
> > Dim LastRow As Long, xR As Long
> > With ActiveSheet
> > LastRow = .Cells(Rows.Count, "G").End(xlUp).Row
> > For xR = LastRow To 6 Step -1
> > If .Cells(xR, "G") < Date Then _
> > Rows(xR).EntireRow.Delete
> > Rows(31).EntireRow.Insert
> > Next xR
> > End With
> >
> > End Sub
> >
> > Thanks for your help!
>
>
>

Dan,

Sure, it is inserting rows - they're just blank. Insert the numbers 1
through 45 in column A (or any other blank column) to see what it does.

But what row should be copied? Perhaps, change to this, to copy the current
31st row, and increment the date in column G:

Sub DeleteOldRows2()
Dim LastRow As Long, xR As Long

LastRow = Cells(Rows.Count, "G").End(xlUp).Row
For xR = LastRow To 6 Step -1
If Cells(xR, "G") < Date Then
Rows(31).EntireRow.Copy
Rows(31).Insert Shift:=xlDown
Rows(xR).EntireRow.Delete
Range("G31").Value = Range("G30").Value + 1
End If
Next xR

End Sub

Note that With Activesheet is Excel's default, and is rarely needed.

HTH,
Bernie
MS Excel MVP



"Dan E." <[email protected]> wrote in message
news:[email protected]...
> Bernie - did as suggested, now it will not add additional rows. It
> deletes
> fine, but the add command doesn't seem to be executed.
>
> OK, updated code:
>
> Sub DeleteOldRows()
> Dim LastRow As Long, xR As Long
> With ActiveSheet
> LastRow = .Cells(Rows.Count, "G").End(xlUp).Row
> For xR = LastRow To 6 Step -1
> If .Cells(xR, "G") < Date Then
> Rows(xR).EntireRow.Delete
> Rows(31).EntireRow.Insert
> End If
> Next xR
> End With
>
> End Sub
>
>
> "Bernie Deitrick" wrote:
>
>> Dan,
>>
>> Change
>>
>> If .Cells(xR, "G") < Date Then _
>> Rows(xR).EntireRow.Delete
>> Rows(31).EntireRow.Insert
>>
>> to
>>
>> If .Cells(xR, "G") < Date Then
>> Rows(xR).EntireRow.Delete
>> Rows(31).EntireRow.Insert
>> end if
>>
>>
>> HTH,
>> Bernie
>> MS Excel MVP
>>
>>
>> "Dan E." <[email protected]> wrote in message
>> news:[email protected]...
>> >I have a workbook which contains a worksheet that has project data,
>> >including
>> > project end date. Users update the sheet with current and projected
>> > projects. I have written a macro to remove entries whose end date (in
>> > column
>> > "G") are older than the current date.
>> >
>> > The macro as written works, however when I run the macro it inserts a
>> > blank
>> > row for every project listed in the spreadsheet. How do I get it to
>> > insert a
>> > new row only when it deletes a row? And how do I make sure that the
>> > new,
>> > inserted row is at the bottom of the formatted data (which ends at row
>> > 31)?
>> >
>> > Sub DeleteOldRows()
>> > Dim LastRow As Long, xR As Long
>> > With ActiveSheet
>> > LastRow = .Cells(Rows.Count, "G").End(xlUp).Row
>> > For xR = LastRow To 6 Step -1
>> > If .Cells(xR, "G") < Date Then _
>> > Rows(xR).EntireRow.Delete
>> > Rows(31).EntireRow.Insert
>> > Next xR
>> > End With
>> >
>> > End Sub
>> >
>> > Thanks for your help!
>>
>>
>>

Bernie,

Appreciate the tip. I did what you said and realized that I was inserting
the new rows outside of my formatted area, that's why it looked like it
wasn't working. Then I realized I could use the LastRow variable to insert
after the last bit of data in my table. And I used the with ActiveSheet just
to keep anything unexpected from happening

Final code below for future use:

Sub DeleteOldRows()
Dim LastRow As Long, xR As Long
With ActiveSheet
LastRow = .Cells(Rows.Count, "G").End(xlUp).Row
For xR = LastRow To 6 Step -1
If .Cells(xR, "G") < Date Then
Rows(xR).EntireRow.Delete
Rows(LastRow).EntireRow.Insert
End If
Next xR
End With

End Sub

"Bernie Deitrick" wrote:

> Dan,
>
> Sure, it is inserting rows - they're just blank. Insert the numbers 1
> through 45 in column A (or any other blank column) to see what it does.
>
> But what row should be copied? Perhaps, change to this, to copy the current
> 31st row, and increment the date in column G:
>
> Sub DeleteOldRows2()
> Dim LastRow As Long, xR As Long
>
> LastRow = Cells(Rows.Count, "G").End(xlUp).Row
> For xR = LastRow To 6 Step -1
> If Cells(xR, "G") < Date Then
> Rows(31).EntireRow.Copy
> Rows(31).Insert Shift:=xlDown
> Rows(xR).EntireRow.Delete
> Range("G31").Value = Range("G30").Value + 1
> End If
> Next xR
>
> End Sub
>
> Note that With Activesheet is Excel's default, and is rarely needed.
>
> HTH,
> Bernie
> MS Excel MVP
>