VBA delete rows based on date

ai1094

Board Regular
Joined
Aug 23, 2018
Messages
92
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 *
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
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.

Code:
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
 
Upvote 0

Forum statistics

Threads
1,213,496
Messages
6,113,995
Members
448,539
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top