Deleting an Entire Row using a Macro

[ejd0077]

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.

[spg2112]

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

[Colo]

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

[Dave Hawley]

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.