Thanks Thanks:  0
Likes Likes:  0
Results 1 to 4 of 4

Thread: Deleting an Entire Row using a Macro

  1. #1
    New Member
    Join Date
    Mar 2002
    Location
    Arkansas
    Posts
    15
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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.

  2. #2
    Board Regular
    Join Date
    Feb 2002
    Location
    Dallas, TX
    Posts
    316
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  3. #3
    MrExcel MVP
    Colo's Avatar
    Join Date
    Mar 2002
    Location
    Kobe, Japan
    Posts
    1,456
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    2 Thread(s)

    Default

    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

  4. #4
    Rest in Peace
    Join Date
    Feb 2002
    Posts
    1,582
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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.




Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •