vbadatedelete-row

Delete rows based on date using VBA


Each month new data (from the previous month) is pasted over old data. The number of days each month changes due to nonwork days.

I tried clearing the cells and pasting data in blank cells, but this messes up the associated charts and graphs.

I want to delete entire rows with data before the last month, day 1.

Example of data

Sub ltest()

Dim d As Date
d = DateAdd("y", -1, Date)
LastMonth = Month(DateAdd("m", -1, Date))

Dim w As Long
For w = Sheet1.[a4].SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
    Debug.Print Cells(w, "A").Value
    If CDate(Cells(w, "A")) < CDate(LastMonth) Then
        Cells(w, "A").EntireRow.Delete
    End If
Next w

End Sub

Another attempt

Sub DeleteRowBasedOnDateRange()
Dim N As Long, I As Long
Dim lmon As Long

lmon = Month(DateAdd("m", -1, 1))
N = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row

For I = N To 1 Step -4
    If Sheet1.Cells(I, "A").Value < lmon Then
        Sheet1.Rows(I).Delete
    End If
Next I

End Sub

Solution

  • example:

    Sub DeleteOldDates()
        Dim ws As Worksheet
        Dim lastRow As Long
        Dim previousM As Date
        Dim i, rowDate
        
    Application.ScreenUpdating = False
    
        Set ws = ThisWorkbook.Worksheets("Sheet1") 'Change "Sheet1" to your sheet's name
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'Get last row in column A
        
        'Get current month and subtract 1 to get previous month
        previousM = DateSerial(Year(Date), Month(Date) - 1, 1)
            
        For i = lastRow To 1 Step -1
        rowDate = Cells(i, "A").Value
            If IsDate(rowDate) Then 'Check if cell contains a valid date
                If Year(rowDate) < Year(previousM) Then
                    Cells(i, "A").EntireRow.Delete
                ElseIf Month(rowDate) < Month(previousM) And Year(rowDate) = Year(previousM) Then
                    Cells(i, "A").EntireRow.Delete
                End If
            End If
        Next i
        
    Application.ScreenUpdating = True
    End Sub