Avatar of Utredning
Utredning
 asked on

Delete rows based on date criteria

Hi,

I am looking for a macro that delete rows based on date criterias. 

My data table starts in cell A10. And this first column contains a date. And would like to have all rows containg today's date deleted. 

Microsoft OfficeMicrosoft Excel* MS Excel Macro

Avatar of undefined
Last Comment
Utredning

8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
Martin Liss

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Roy Cox

The fastest way with a large set of data would be  to use AutoFilter. Try this

Sub deleteFilteredData()
    Dim rDelete    As Range
    Dim lCalc  As Long
    Dim sDelete As String
    
    With Application
        lCalc = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        On Error GoTo exit_proc
        
        ''///Sheet with the data, change the name
        With ActiveSheet
            .AutoFilterMode = False
            ''///Apply the filter, this range of data starts in A1
            .Cells(1, 1).CurrentRegion.AutoFilter Field:=1, Criteria1:="=" & Date
            With .AutoFilter.Range
                On Error Resume Next
                Set rDelete = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
                .SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
                If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
            End With
            ''///Remove the AutoFilter
            .AutoFilterMode = False
        End With
        
exit_proc:
        .ScreenUpdating = True
        .Calculation = lCalc
    End With
    
End Sub

Open in new window

Martin Liss

I’m glad I was able to help.

If you expand the “Full Biography" section of my profile you’ll find links to some articles I’ve written that may interest you.

Marty - Microsoft MVP 2009 to 2017
              Experts Exchange Most Valuable Expert (MVE) 2015, 2017
              Experts Exchange Distinguished Expert in Excel 2018
              Experts Exchange Top Expert Visual Basic Classic 2012 to 2020
              Experts Exchange Top Expert VBA 2018 to 2020
Utredning

ASKER
Thanks for your help :)
Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes