Deleting an Entire Row using a Macro

ejd0077

New Member
Joined
Mar 4, 2002
Messages
15
I have a workbook that has two dates in adjacent columns (D&E). I want to compare the two dates and if the date in Column E is > the date in Column D, I want to delete the entire row. I have no estimate of how many rows this workbook will have before it is done, so I need the macro to loop until the column A entry is blank ("").

If I can't delete the rows, I can live with clearing the contents and then I will resort the info to get rid of the blank rows.

Also, I would like for this macro to run when the workbook is opened.

Any help would be appreciated.
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
I don't know how to make it run at startup, and this very sloppy...hey it's 5 O'clock on Good Friday. I'm sure there's a better way.

Steve

Sub Beth()

Dim a As Variant
a = 0

Range("E1").Select
Range(Selection, Selection.End(xlDown)).Select 'highlight the records
Selection.Name = "countrecords" 'name the range for summing
ActiveCell.Select
Selection.End(xlDown).Select
ActiveCell.Offset(2, 0).Select
ActiveCell.Formula = "=Counta(countrecords)" 'count the records

a = ActiveCell.Value 'set the active cell to variable a

Range("F1").Select
ActiveCell.Formula = "=IF(E2>D2,""T"",""F"")"
ActiveCell.Copy
Range(Selection, Selection.Offset(a - 1, 0)).Select
Selection.PasteSpecial xlFormulas
Range("F1").Select
Range(Selection, Selection.Offset(a - 1, 0)).Select
Selection.Copy
Selection.PasteSpecial xlValues


Do Until a = 0
a = a - 1
If ActiveCell.Value = "F" Then
ActiveCell.Offset(1, 0).Select
Else
Selection.EntireRow.Delete
End If
Loop

End Sub
 
Upvote 0
Hi. Please copy this into a standard module.

Sub Auto_Open()
Dim lngRow As Long
For lngRow = Cells(Rows.Count, "D").End(xlUp).Row To 1 Step -1
If IsEmpty(Cells(lngRow, 1)) Then Exit For
If Cells(lngRow, "D").Value < Cells(lngRow, "E").Value Then
Cells(lngRow, "D").EntireRow.Delete
End If
Next
End Sub
 
Upvote 0
Hi Beth

Right click on the Excel icon (top left next to "File") and select "View Code" in here paste:

Private Sub Workbook_Open()
Run "DeleteRows"
End Sub


No in a standard module (Insert>Module) place this:

Sub DeleteRows()
Dim rRange As Range
With Sheets("Sheet1")
.Columns("F:F").EntireColumn.Insert
Set rRange = .Range("E2", .Range("E65536").End(xlUp)).Offset(0, 1)

rRange.FormulaR1C1 = "=IF(RC[-1]>RC[-2],1,"""")"

Set rRange = rRange.SpecialCells(xlCellTypeFormulas, _
xlNumbers)
rRange.EntireRow.Delete
.Columns("F:F").EntireColumn.Delete
End With
End Sub

The big advantage with this method is it avoids looping through all cells. It simple Inserts a column in Column "F", places a very simple comaparison formula in. Then Sets a range to all the TRUE comparisons and deletes all the row in one go.
 
Upvote 0

Forum statistics

Threads
1,213,552
Messages
6,114,278
Members
448,560
Latest member
Torchwood72

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top