VBA delete rows based on date

[ai1094]

I need help creating a VBA code that will delete rows based on a date. If possible, I would like for the code to delete the rows from the previous month. I want it to be dynamic so that it will work with any previous vs. current month.

For Example:

I have June 2019 and July 2019 data. Is it possible to write a VBA code that will delete previous month data (June 2019) and point to a new workbook to copy August 2019 data into the existing workbook?

* If it helps, I have my dates stored in Column C *

 

[pbornemeier]

This code does what you specified before the example. The example seems to conflict with the specified requirements and itself. Please reword it if the provided code does not perform as desired.

Option Explicit

Sub RemoveRowsFromPreviousMonth()
    'Examine the active worksheet and remove all rows where the date in column C is in the prior month
    
    
    Dim lChooseWhatToDelete As Long
    lChooseWhatToDelete = 0                 '0 to let user select at run time
                                            '1 to auto delete rows from the prior month
                                            '2 to delete rows with dates older than the prior month
                                            '3 to delete all rows before the current month
    Dim lLastRow As Long
    Dim lMonth As Long
    Dim dteFirstOfMonth As Date
    Dim dteLastOfPriorMonth As Long
    Dim dteFirstOfPriorMonth As Date
    Dim lCurrMonthCount As Long
    Dim lLastMonthCount As Long
    Dim lOlderCount As Long
    Dim lDeleteCount As Long
    Dim sChoice As String
                                                                                       
    With ActiveSheet
        dteFirstOfMonth = DateSerial(Year(Now()), Month(Now()), 1)
        dteLastOfPriorMonth = dteFirstOfMonth - 1
        dteFirstOfPriorMonth = DateSerial(Year(dteLastOfPriorMonth), Month(dteLastOfPriorMonth), 1)
        .AutoFilterMode = False
        lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        If lChooseWhatToDelete = 0 Then
            'Get user input
            .Range("A1").CurrentRegion.AutoFilter Field:=3, _
                Criteria1:=xlFilterThisMonth, Operator:=xlFilterDynamic
            lCurrMonthCount = Application.WorksheetFunction.Subtotal(3, .Columns(1)) - 1
            .Range("A1").CurrentRegion.AutoFilter Field:=3, _
                Criteria1:=xlFilterLastMonth, Operator:=xlFilterDynamic
            lLastMonthCount = Application.WorksheetFunction.Subtotal(3, .Columns(1)) - 1
            .Range("A1").CurrentRegion.AutoFilter Field:=3, _
                Criteria1:="<" & dteFirstOfPriorMonth, Operator:=xlAnd
            lOlderCount = Application.WorksheetFunction.Subtotal(3, .Columns(1)) - 1
            .AutoFilterMode = False
            lChooseWhatToDelete = InputBox(lCurrMonthCount & " row(s) for the current month, " & Format(dteFirstOfMonth, "mmmm yyyy") & vbLf & _
                lLastMonthCount & " row(s) for the prior month, " & Format(dteFirstOfPriorMonth, "mmmm yyyy") & vbLf & _
                lOlderCount & " row(s) before prior month. " & vbLf & vbLf & _
                "Enter 1 to delete prior month rows." & vbLf & _
                "Enter 2 to delete rows before prior month." & vbLf & _
                "Enter 3 to delete all rows before the first of the current month.", , "")
        End If
        Select Case lChooseWhatToDelete
        Case 1
            sChoice = "delete prior month rows"
            .Range("A1").CurrentRegion.AutoFilter Field:=3, _
                Criteria1:=xlFilterLastMonth, Operator:=xlFilterDynamic
        Case 2
            sChoice = "delete rows before prior month"
            .Range("A1").CurrentRegion.AutoFilter Field:=3, _
                Criteria1:="<" & dteFirstOfPriorMonth, Operator:=xlAnd
        Case 3
            sChoice = "delete all rows before the first of the current month"
            .Range("A1").CurrentRegion.AutoFilter Field:=3, _
                Criteria1:="<" & dteFirstOfMonth, Operator:=xlAnd
        Case Else
            MsgBox lChooseWhatToDelete & " was not a valid choice."
            GoTo End_Sub
        End Select
        lDeleteCount = Application.WorksheetFunction.Subtotal(3, .Columns(1)) - 1
        If lDeleteCount > 0 Then
            .Range(.Cells(2, 1), .Cells(lLastRow, 1)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            .AutoFilterMode = False
            MsgBox lDeleteCount & " rows deleted, user chose " & lChooseWhatToDelete & " (" & sChoice & ")"
        Else
            .AutoFilterMode = False
            MsgBox "No rows deleted, user chose " & lChooseWhatToDelete & " (" & sChoice & ")"
        End If
    
    End With
    
End_Sub:

End Sub