VBA delete rows 2 or more days after a certain date

[background]

This problem is driving me insane

I have thousands of lines of data, and in columns H and I, there are dates. I want my macro to go through and delete all rows where the date in column I is 2 or more days after the date in column H. The number of lines depends on the data I download, so I should Dim a header row and the bottom row as integers. Could someone please help me find a solution to this bloody problem? Thank you!

 

[Joe4]

Welcome to the Board!

Please post a small sample of your data so we can see the data structure. It would be most helpful to see header rows and the first few lines of data, and then the last few lines of data and the trailer rows.

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

 

[Alex Blakenburg]

See if this works for you:-
Change the Const dayLimit if you decided you want to use a different no of days as the deletion criteria.
I am assuming your data starts in A1.

Sub DeleteRows()

    Const dayLimit As Long = 2
    Dim rng As Range
    Dim rngData As Range
    Dim arrSrc As Variant
    Dim arrDays() As Long
    Dim sht As Worksheet
    Dim lastCol As Long, lastRow As Long, delRowStart As Long
    Dim i As Long
    
    Set sht = ActiveSheet
    Set rng = sht.Range("A1").CurrentRegion
    Set rngData = rng.Offset(1).Resize(rng.Rows.Count - 1)
    
    arrSrc = rngData.Value2
    ReDim arrDays(1 To UBound(arrSrc), 1 To 2)
    
    lastCol = rng.Columns.Count
    lastRow = rng.Rows.Count
    
    For i = 1 To UBound(arrSrc)
        If arrSrc(i, 9) - arrSrc(i, 8) >= dayLimit Then
            arrDays(i, 1) = 1       ' Flag for deletion
        Else
            arrDays(i, 1) = 0
        End If
        arrDays(i, 2) = i           ' Index number for sort if required
    Next i
   
    rngData.Columns(lastCol).Offset(0, 1).Resize(, 2).Value = arrDays
    rng.Columns(lastCol).Offset(, 1).Resize(1, 2).Value = Array("Delete Flag", "Index")
    
    With sht.Sort
        .SortFields.Add Key:=rng.Columns(lastCol + 1).Cells(1, 1), Order:=xlAscending
        .SetRange rng.Resize(, lastCol + 2)
        .Header = xlYes
        .Apply
    End With
    
    If Not rngData.Columns(lastCol + 1).Find(1) Is Nothing Then
        delRowStart = rngData.Columns(lastCol + 1).Find(1).Row
        Range(Cells(delRowStart, "A"), Cells(lastRow, "A")).EntireRow.Delete
    End If
    
    rng.Columns(lastCol + 1).Resize(, 2).EntireColumn.Delete
    
    ' Reset UsedRange
    sht.Activate
    ActiveSheet.UsedRange

End Sub

 

[background]

See if this works for you:-
Change the Const dayLimit if you decided you want to use a different no of days as the deletion criteria.
I am assuming your data starts in A1.

Sub DeleteRows()

    Const dayLimit As Long = 2
    Dim rng As Range
    Dim rngData As Range
    Dim arrSrc As Variant
    Dim arrDays() As Long
    Dim sht As Worksheet
    Dim lastCol As Long, lastRow As Long, delRowStart As Long
    Dim i As Long
   
    Set sht = ActiveSheet
    Set rng = sht.Range("A1").CurrentRegion
    Set rngData = rng.Offset(1).Resize(rng.Rows.Count - 1)
   
    arrSrc = rngData.Value2
    ReDim arrDays(1 To UBound(arrSrc), 1 To 2)
   
    lastCol = rng.Columns.Count
    lastRow = rng.Rows.Count
   
    For i = 1 To UBound(arrSrc)
        If arrSrc(i, 9) - arrSrc(i, 8) >= dayLimit Then
            arrDays(i, 1) = 1       ' Flag for deletion
        Else
            arrDays(i, 1) = 0
        End If
        arrDays(i, 2) = i           ' Index number for sort if required
    Next i
  
    rngData.Columns(lastCol).Offset(0, 1).Resize(, 2).Value = arrDays
    rng.Columns(lastCol).Offset(, 1).Resize(1, 2).Value = Array("Delete Flag", "Index")
   
    With sht.Sort
        .SortFields.Add Key:=rng.Columns(lastCol + 1).Cells(1, 1), Order:=xlAscending
        .SetRange rng.Resize(, lastCol + 2)
        .Header = xlYes
        .Apply
    End With
   
    If Not rngData.Columns(lastCol + 1).Find(1) Is Nothing Then
        delRowStart = rngData.Columns(lastCol + 1).Find(1).Row
        Range(Cells(delRowStart, "A"), Cells(lastRow, "A")).EntireRow.Delete
    End If
   
    rng.Columns(lastCol + 1).Resize(, 2).EntireColumn.Delete
   
    ' Reset UsedRange
    sht.Activate
    ActiveSheet.UsedRange

End Sub

Thanks Alex for your reply. I am yet to try the code, but just wanted to clarify that my data starts in A2. Would it just be a case of amending: Set rng = sht.Range("A1").CurrentRegion to: Set rng = sht.Range("A2").CurrentRegion?

 

[background]

Thanks Alex for your reply. I am yet to try the code, but just wanted to clarify that my data starts in A2. Would it just be a case of amending: Set rng = sht.Range("A1").CurrentRegion to: Set rng = sht.Range("A2").CurrentRegion?

Sorry, there is a header in row 1 (from A1 to I1) so does my proposed amendment still work?

 

[Alex Blakenburg]

If your column headings are in row 1, then it matches my assumption and it should work as is.

 

[background]

If your column headings are in row 1, then it matches my assumption and it should work as is.

Thanks. I've tried running it, but have got a mismatch on the line:

If arrSrc(i, 9) - arrSrc(i, 8) >= dayLimit Then. Could you help me out please?

 

[Alex Blakenburg]

It’s 1am here in Sydney Australia, as Joe mentioned can you post an XL2BB of some of your data.
If you really can’t I at least need a screenshot showing the row and column references and some of the data.
Try adding a column that subtracts Column H from Column I and see if it produces errors. The Macro will error out if that subtraction doesn’t work.
I will respond in your tomorrow.

 

[Siddharth Rout]

I would do this slightly in a different way. I will let Excel do all the dirty work.

LOGIC

1. Insert a helper column in Col J
2. Insert the DATEDIF formula to calculate date difference
3. Filter the helper column on date difference >=2
4. Delete the relevant rows
5. Finally delete the helper column

CODE

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long
    Dim delRange As Range
   
    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")
   
    With ws
        .AutoFilterMode = False
       
        '~~> Find last row in Col H
        lRow = .Range("H" & .Rows.Count).End(xlUp).Row
       
        '~~> Insert a helper column in col J
        .Columns(10).Insert Shift:=xlToRight
       
        '~~> Add header
        .Range("J1").Value = "TempHeader"
       
        '~~> Insert the DatedIf formula in all cells in 1 go
        .Range("J2:J" & lRow).Formula = "=DATEDIF(H2,I2,""d"")"
       
        '~~> Filter on date >=2
        With .Range("J1:J" & lRow)
            .AutoFilter Field:=1, Criteria1:=">=2"
           
            Set delRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
        End With
       
        '~~> Delete the rows in 1 go if applicable
        If Not delRange Is Nothing Then delRange.Delete
       
        '~~> Delete the helper column
        .Columns(10).Delete
    End With
End Sub

SCREENSHOT

 

[Alex Blakenburg]

@Siddharth Rout it’s very slightly different . My helper column is getting done in memory based on the reference to “thousands of lines”, I also wanted to sort to consolidate the rows to be deleted for the same reason.
Wish my code looked as clean as yours though