Avatar of RWayneH
RWayneHFlag for United States of America asked on

Deleting a bunch of rows. Autofilter

I have another delete rows request... prefer with autofilter, (it is a bigger file and will delete around 25,000 rows)
On column AG or ActiveSheet.UsedRange.AutoFilter Field:=33,

How would I modify the code below to delete rows based on the following:

I want to delete everything, except the blanks, and dates = today, and yesterday.


Ending with the filter on only today and yesterdays records.  (no blanks)  -R-




Sub Macro()
    Rows("1:1").AutoFilter
    ActiveSheet.UsedRange.AutoFilter Field:=1, Criteria1:="=-", _
        Operator:=xlOr, Criteria2:= _
        "=-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------"
    LastRow = Cells(Cells.Rows.Count, 1).End(xlUp).Row
    LastColumn = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    Range(Range("A2"), Cells(LastRow, LastColumn)).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
End Sub 

Open in new window

ZGSRF029.xlsx
Microsoft ExcelMicrosoft Applications

Avatar of undefined
Last Comment
aikimark

8/22/2022 - Mon
aikimark

Did your posted workbook include the rows you want to delete?  This data looks like it might have already been cleaned.
ASKER
RWayneH

Sorry it proably did.  Here is another sample to work from. -R-
ZGSRF029v2.xlsx
ASKER
RWayneH

Not sure if this is an issue, but I did not recall if the autofilter was on or off when this needs to run.  If it matters I can look that up. -R-
I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst
William Peck
aikimark

which of the several date columns need to be checked?  

Note: AG is not a date column.
ASKER
RWayneH

I am so sorry, I had to run some code to format the file...  this new sample file is the one.  AG is a date in this one.  I appreciate you hangin with me on this one.  Thanks. -R-
ZGSRF029v3.xlsx
aikimark

You will need to run this from an .xlsm or .xls workbook, since .xlsx workbooks do not allow macro execution.
Option Explicit

Public Sub Q_28325796()
    Dim dtToday As Date
    Dim wks As Worksheet
    Dim rng As Range
    Dim lngLoop As Long
    Dim lngEndRow As Long
    Dim lngStartRow As Long
    
    Set wks = ActiveSheet
    dtToday = Date
    
    'delete the hyphen row
    Set rng = wks.Range("A1").End(xlDown)
    If rng.Text Like "-*" Then
        rng.EntireRow.Delete
        Set rng = wks.UsedRange
    End If
    'iterate the AG cells from bottom to top, deleting the rows
    'with dates <> yesterday or today
    Application.ScreenUpdating = False
    lngEndRow = -1
    lngStartRow = lngEndRow + 1
    lngLoop = wks.Range("AG2").End(xlDown).Row
    For lngLoop = lngLoop To 2 Step -1
        If IsDate(wks.Cells(lngLoop, 33).Text) Then
            Select Case wks.Cells(lngLoop, 33).Text
                Case dtToday - 1 To dtToday
                    lngStartRow = lngLoop + 1
                    If lngStartRow <= lngEndRow Then
                        wks.Range(wks.Rows(lngStartRow), wks.Rows(lngEndRow)).Delete
                        Application.StatusBar = "Deleted rows: " & lngStartRow & " to " & lngEndRow
                    End If
                    lngEndRow = -1
                Case Else
                    If lngEndRow = -1 Then
                        lngEndRow = lngLoop
                    End If
            End Select
        Else
            lngStartRow = lngLoop + 1
            If lngStartRow <= lngEndRow Then
                wks.Range(wks.Rows(lngStartRow), wks.Rows(lngEndRow)).Delete
                Application.StatusBar = "Deleted rows: " & lngStartRow & " to " & lngEndRow
            End If
            lngEndRow = -1
        End If
    Next
    Application.ScreenUpdating = True
    ActiveSheet.UsedRange.AutoFilter Field:=33, Criteria1:=">=" & dtToday - 1, Operator:=xlAnd, Criteria2:="<=" & dtToday
    Application.StatusBar = vbNullString
End Sub

Open in new window

Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
ASKER
RWayneH

This macro did work?  Perphaps because today is a Sunday and there was no data = today, however there was some yesterday data,  just like tomorrow there will only be today data and not any yesterday data.

File v4 is after your macro run
File v5 was before your macro run
File v6 is what it is supposed to look like after todays running.

Any idea what went wrong? -R-
ZGSRF029v4.xlsx
ASKER
RWayneH

Samplev5
ZGSRF029v5.xlsx
ASKER
RWayneH

What the final solution should produce V6, even though there is only yesterdat data 12-28, no data for today 12-29 a Sunday.  When run tomorrow 12-30, there will only be today data, and no yesterday, because the only data previously was a yesterday, leaving the 12-30 running data as just that day.
ZGSRF029v6.xlsx
All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
aikimark

The dates are being compared as text values.

Change line 51 to
    ActiveSheet.UsedRange.AutoFilter Field:=33, Criteria1:="=" & dtToday - 1, Operator:=xlOr, Criteria2:="=" & dtToday

Open in new window

aikimark

Just to be on the safe side, change line 28 to
            Select Case CDate(wks.Cells(lngLoop, 33).Value)

Open in new window

ASKER
RWayneH

Ok, I made edits and the final output is still not being completed.. (see what is left in the filter of column AG of the SampleV6 file.  Something is still not right..  We are deleting everything except the today, yesterday and blanks.  Leaving the filter on yesterday and today (no blanks)

there are still plenty of records left even after your edits..  ?    -R-
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
aikimark

Good catch.  I've simplified the algorithm and it is much faster than any prior version.  To facilitate testing, I added an optional parameter that allows you/me to supply a date, rather than using the system date on the PC.  The results seem to be what you want.
Option Explicit

Public Sub Q_28325796(Optional parmDate)
    Dim dtToday As Date
    Dim wks As Worksheet
    Dim rng As Range
    Dim lngLoop As Long
    Dim lngEndRow As Long
    Dim lngStartRow As Long
    
    Set wks = ActiveSheet
    If IsMissing(parmDate) Then
        dtToday = Date
    Else
        dtToday = parmDate
    End If
    'delete the hyphen row
    Set rng = wks.Range("A1").End(xlDown)
    If rng.Text Like "-*" Then
        rng.EntireRow.Delete
        Set rng = wks.UsedRange
    End If
    Application.ScreenUpdating = False
    
    'Insert a new column beside AG and create a header
    wks.Columns(34).Insert
    wks.Cells(1, 34).Value = "DateValue"
    'populate the new column with date values from column AG
    wks.Range(wks.Cells(2, 34), wks.Cells(wks.Cells.SpecialCells(xlCellTypeLastCell).Row, 34)).FormulaR1C1 = "=N(rc[-1])"
    'sort by the new date value column
    wks.Range("A1").CurrentRegion.Sort key1:=wks.Cells(1, 34), header:=xlYes
    
    'iterate the AH cells from bottom to top, deleting the rows
    'with dates <> yesterday or today
    lngEndRow = -1
    lngStartRow = lngEndRow + 1
    lngLoop = wks.Range("AH2").End(xlDown).Row
    For lngLoop = lngLoop To 2 Step -1
        Select Case wks.Cells(lngLoop, 34).Value
            Case dtToday - 1 To dtToday, 0
                lngStartRow = lngLoop + 1
                If lngStartRow <= lngEndRow Then
                    wks.Range(wks.Rows(lngStartRow), wks.Rows(lngEndRow)).Delete
                    Application.StatusBar = "Deleted rows: " & lngStartRow & " to " & lngEndRow
                End If
                lngEndRow = -1
            Case Else
                If lngEndRow = -1 Then
                    lngEndRow = lngLoop
                End If
        End Select
    Next
    'delete the datevalue column
    wks.Columns(34).Delete
    'sort by column 1
    wks.Range("A1").CurrentRegion.Sort key1:=wks.Cells(1, 1), header:=xlYes
    
    Application.ScreenUpdating = True
    ActiveSheet.UsedRange.AutoFilter Field:=33, Criteria1:="=" & dtToday - 1, Operator:=xlOr, Criteria2:="=" & dtToday
    Application.StatusBar = vbNullString
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Rob Brockett

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.
See how we're fighting big data
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
ASKER
RWayneH

aikimark:   Still not finishing with the filter on today and yesterday?  There can just be today, just be yesterday or both on a given day.  (leaving the blanks out )  Can we add something to the end of this that will do this?  Just about there.  Please advise and thanks.

 broro183:  Bob, thanks and yes it is a SAP extract, and we are applying a variant already, however because the extra data is used for various other reports, we needed to extract it all and then go from that extract.. thus we have to strip out all that unneeded stuff for the last report.

  -R-
aikimark

@RWayneH

I'm not sure of your logic.  Please give some examples of single-day processing.
Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy
ASKER
RWayneH

At the end of the procedure I have some other macros that run, but do not use the blanks at that time.  The blanks are use later in a whole different report..... long story/explaination.

At this point in the macro, I need it to stop on requested yesterday or today, and/both.  The final output is in V6.  Please finish the macro on that layout.  thanks -R-
aikimark

Have you tested the code I posted?
ASKER
RWayneH

Yes..  it is just not ending on the correct filter, leaving out the blanks and just leaving everything else after the deletes are done..  It looks like Ln 59 is trying to reset the filter, but it does not.  For some reason it is not leave the data filter as desired.  Can you take a look at Ln 59? or look at why it is not honoring that last filter?  -R-
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
aikimark

do not set a filter before you run the code
ASKER
RWayneH

It has tested out pretty good so far, I am going to check it for the next couple days to see if it is consistent when new data files come in and it see if it is picking up the correct days..    so far so good.  Thanks. -R-
aikimark

I can tweak the performance a bit more, but it seems to be quite snappy in my testing.
Your help has saved me hundreds of hours of internet surfing.
fblack61
ASKER
RWayneH

Ok it appears to be working to delete the rows, however I need to stop the macro, there and manually select today and yesterdays records (making sure that blanks is unchecked, because the macro is not ending on the correct step.  Then restart another marco from there.

Issue is the last request to have the procedure end at the required spot/selection.
Attached file (V7) is before your code runs, which includes a today and yesterday. (12-30 and 12-31)  My tests on this result with neither of these selected.  I will send a V8 that is a post macro run, showing them unselected...  Are your tests showing the same thing?

Why is the exit point not being honored? -R-
ZGSRF029v7.xlsx
ASKER
RWayneH

Here is the post macro output, no today or yesterday selected.  I see your code cleared filters.  Any ideas? -R-
ZGSRF029v8.xlsx
aikimark

I do not understand.  Your problem (as stated) seems to be solved.  The code will, by default, delete all rows that contain dates for other that yesterday or today, preserving the blank/spaces (non-date) rows, and then apply a filter to show the yesterday/today rows.
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
ASKER
RWayneH

Notice the difference in the screenshot attached... the blanks are left out of the exit point and are used at another time.  Only today and yesterday are checked so the procedure can continue.  Does that make more sense?  -R-

ScreenShotOfIssue
ASKER
RWayneH

All my testing has produced the same result... nothing in the autofilter in column AG is checked all checkboxes are empty.  Need two of the three checked...  today and yesterday. -R-
ASKER
RWayneH

or is it sorted the correct way? and the autofilter form just does not show that it is?  When I read Ln59 it looks as if it is applying it, but when I click on autofilter dropdown it does not show that way?  Maybe I am missing something here?  -R-
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
aikimark

It looks like your AG column contains actual dates.  I used 2003 which shows the column contents as text.  If you are getting different results in the autofilter, I would probably attribute it to that difference.  Is it possible that you have done some extra processing on the data?

I see the autofilter dialog difference.  Does this mean that the actual (yesterday and today) date values are not filtered in the column?
ASKER
RWayneH

That was the core of my question.. and the way it looks, it is not filtered, so that is why I need to go in after your code runs and manually check the boxes for today and yesterday.  The icon at the dropdown looks like there is something applied to it, but it does not say or show what?

It is a critical part of the process that blanks stay out of that autofilter, because in the next step I am deleting items based on the today and yesterday filter only.  I am running some more tests, but each test is returning the same... no filter is being applied.  I have not looked specifically for blanks but the next test I will.   Will let you know and thanks. -R-
ASKER
RWayneH

I just tested this again, and for some reason the filter is applied correctly, even though the checkboxes are not checked, the blanks are not there.  I was going by what the autofilter dropdown was saying instead of what was phyiscally in the column...  that is why I was going on on and about it not being filtered correctly....  sorry.

I am going to watch this for a couple days and verify it is working correctly..  thanks -R-
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Rob Brockett

hi everyone,

RWayneH,
When I run Aikimark's code using excel 2007 I saw the same thing as you have shown in your snippet. I had a closer look & the filter criteria are shown if you click on the "Text Filters". I was able to get the checkboxes to show as being ticked in the first level of the dropdown by changing line 59 from the defining the two inclusions
 ActiveSheet.UsedRange.AutoFilter Field:=33, Criteria1:="=" & dtToday - 1, Operator:=xlOr, Criteria2:="=" & dtToday

Open in new window

to instead define the single exclusion
    wks.UsedRange.AutoFilter Field:=33, Criteria1:="<>          "

Open in new window


Aikimark,
I had initially thought that cell by cell checking would be much slower than other approaches such as Autofilter or using an "in memory array" but after some testing I must admit that my initially thoughts were wrong & your code really is quite snappy :-)
I've had a go at tweaking it & this is what I came up with. Is this similar to how you would tweak it?
(noting that the 0 to 1/2 second improvement means there isn't much of a change in performance in my tweaked version!)
Public Sub Q_28325796_v3(Optional parmDate)
'original version sourced from http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28325796.html#a39744749

Const DelAGIDateCol As Long = 33
Dim dtToday As Date
Dim wks As Worksheet
Dim rng As Range
Dim lngLoop As Long
Dim lngEndRow As Long
Dim lngStartRow As Long
Dim DelAGIDateArr As Variant

    Call ToggleRefreshXlApp(False)

    '    Set wks = Worksheets("ZGSRF029 (2)")
    Set wks = ActiveSheet
    If IsMissing(parmDate) Then
        dtToday = Date
        ''### for testing
        '       dtToday = "28 December 2013"
    Else
        dtToday = parmDate
    End If

    'delete the hyphen row
    Set rng = wks.Range("A1").End(xlDown)
    If rng.Text Like "-*" Then
        rng.EntireRow.Delete
        Set rng = wks.UsedRange
    End If
    '    Application.ScreenUpdating = False

    'sort by the date value column
    rng.Sort key1:=wks.Cells(1, DelAGIDateCol), Header:=xlYes
    DelAGIDateArr = rng.Columns(DelAGIDateCol)
    Set rng = Nothing

    'iterate the AG cells from bottom to top, to identify a single range for deletion.
    'with dates <> yesterday or today
    lngEndRow = UBound(DelAGIDateArr)
    For lngLoop = UBound(DelAGIDateArr) To (LBound(DelAGIDateArr)) Step -1
        Select Case DelAGIDateArr(lngLoop, 1)
            Case dtToday - 1 To dtToday, "          "
                'keep looping
            Case Else
                lngEndRow = lngLoop
                Exit For
        End Select
    Next lngLoop

'NB: if no rows are found that have the multiple spaces, yesterday's or today's date, then
' the header row will be deleted!
'It seems that it will be very unlikely that no records are found (based on the
'example dataset), but if it does happen the absence of headers will be a warning ;-)
'If this is possible, let us know & some error handling can be added.
    Set rng = wks.Range(wks.Rows(2), wks.Rows(lngEndRow))
    '    Application.StatusBar = "Deleted rows: " & rng.Address
    rng.Delete

    'sort by column 1
    wks.Range("A1").CurrentRegion.Sort key1:=wks.Cells(1, 1), Header:=xlYes

    '   Application.ScreenUpdating = True
    '    Application.StatusBar = vbNullString
    'wks.UsedRange.AutoFilter Field:=DelAGIDateCol, Criteria1:=">=" & Format(dtToday - 1, "dd Mmm yyyy"), Operator:=xlAnd, Criteria2:="<=" & Format(dtToday, "dd Mmm yyyy")
    wks.UsedRange.AutoFilter Field:=DelAGIDateCol, Criteria1:="<>          "
    Call ToggleRefreshXlApp(True)
End Sub

Sub ToggleRefreshXlApp(RefreshAppSettings As Boolean, Optional ByRef xlApp As Excel.Application)
    If xlApp Is Nothing Then
        Set xlApp = Excel.Application
    End If
    With xlApp
        If Not RefreshAppSettings Then
            glb_origCalculationMode = .Calculation
            glb_origStatusBar = .StatusBar
        End If
        .EnableEvents = RefreshAppSettings
        On Error Resume Next
        '        .Calculation = IIf(RefreshAppSettings, glb_origCalculationMode, xlCalculationManual)
        .Calculation = IIf(RefreshAppSettings, xlCalculationAutomatic, xlCalculationManual)
        On Error GoTo 0
        .StatusBar = IIf(RefreshAppSettings, vbNullString, CBool(glb_origStatusBar))
        .ScreenUpdating = RefreshAppSettings
    End With
    Set xlApp = Nothing
End Sub

Open in new window


hth
Rob
aikimark

@Rob

My performance tweak would be to invoke a few .Find() methods after sorting the rows by date to establish the ranges I need to keep or delete.  This would be faster than the iteration of the values.  

Also, I might try moving the sorted dates into a variant array and iterating the array and comparing that performance to the .Find() methods.

The big performance boost (so far) was minimizing the number of .Delete methods I invoke.
ASKER
RWayneH

EXCELent!!  thanks.  After a bunch of testing it proved its worth.. Appreciate the help. -R-
This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.
rwheeler23
Rob Brockett

hi guys,

RWayneH,
Thank you for the points but I feel that they should have gone to Aikimark as he provided the first solution,which then evolved.

Thanks Aikimark, since I had already done some testing I thought I may as well carry on & compare the .Find approach with the others :-)
The results surprised me, because I expected .Find() to come out on top. The results showe that the variant array was the fastest as shown by the snippet but it may have been because I didn't implement the .Find very well. The snippet is presented in milliseconds and shows that the variant array approach was ~1/2 a second faster. Less than a second isn't much in the context we've been given, but (at a stretch!), perhaps the speed difference could become significant with a bigger data set, or if iterating through different files/datasets.

speed comparison
Here is the code for the "fastest" one (Q_28325796_v3) that I tried & for one of the variations where I tried to use .find (Q_28325796_v4)
Public Sub Q_28325796_v3(Optional parmDate)
'original version sourced from http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28325796.html#a39744749
'modified to identify row ranges via the use of a variant array.
Const DelAGIDateCol As Long = 33
Dim dtToday As Date
Dim wks As Worksheet
Dim rng As Range
Dim lngLoop As Long
Dim lngEndRow As Long
Dim lngStartRow As Long
Dim DelAGIDateArr As Variant

    Call ToggleRefreshXlApp(False)

    Set wks = Worksheets("ZGSRF029 (2)")
    'Set wks = ActiveSheet
    If IsMissing(parmDate) Then
        dtToday = Date
        ''### for testing
        '       dtToday = "28 December 2013"
    Else
        dtToday = parmDate
    End If

    'delete the hyphen row
    Set rng = wks.Range("A1").End(xlDown)
    If rng.Text Like "-*" Then
        rng.EntireRow.Delete
        Set rng = wks.UsedRange
    End If
    '    Application.ScreenUpdating = False

    'sort by the date value column
    rng.Sort key1:=wks.Cells(1, DelAGIDateCol), Header:=xlYes, order1:=xlDescending, DataOption1:=xlSortTextAsNumbers
    DelAGIDateArr = rng.Columns(DelAGIDateCol)
    Set rng = Nothing

    'iterate the AG cells from bottom to top, to identify a single range for deletion.
    'with dates <> yesterday or today
    lngEndRow = UBound(DelAGIDateArr)
    For lngLoop = UBound(DelAGIDateArr) To (LBound(DelAGIDateArr)) Step -1
        Select Case DelAGIDateArr(lngLoop, 1)
            Case dtToday - 1 To dtToday, "          "
                'keep looping
            Case Else
                lngEndRow = lngLoop
                Exit For
        End Select
    Next lngLoop


    Set rng = wks.Range(wks.Rows(2), wks.Rows(lngEndRow))
    '    Application.StatusBar = "Deleted rows: " & rng.Address
    rng.Delete

    'sort by column 1
    wks.Range("A1").CurrentRegion.Sort key1:=wks.Cells(1, 1), Header:=xlYes

    '   Application.ScreenUpdating = True
    '    Application.StatusBar = vbNullString
    'wks.UsedRange.AutoFilter Field:=DelAGIDateCol, Criteria1:=">=" & Format(dtToday - 1, "dd Mmm yyyy"), Operator:=xlAnd, Criteria2:="<=" & Format(dtToday, "dd Mmm yyyy")
    wks.UsedRange.AutoFilter Field:=DelAGIDateCol, Criteria1:="<>          "
    Call ToggleRefreshXlApp(True)
End Sub

Open in new window


Public Sub Q_28325796_v4(Optional parmDate)
'v4 uses xlprevious
'original version sourced from http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28325796.html#a39744749

Const DelAGIDateCol As Long = 33
Dim dtToday As Date
Dim wks As Worksheet
Dim rng As Range
Dim lngLoop As Long
Dim lngEndRow As Long
Dim lngStartRow As Long
Dim DelAGIDateArr As Variant

Dim FirstBlankCell As Range
Dim FirstYesterdayCell As Range
Dim FirstTodayCell As Range

    '    Call ToggleRefreshXlApp(False)

    Set wks = Worksheets("ZGSRF029 (2)")
    'Set wks = ActiveSheet
    If IsMissing(parmDate) Then
        dtToday = Date
        ''### for testing
        dtToday = "28 December 2013"
    Else
        dtToday = parmDate
    End If

    'delete the hyphen row
    Set rng = wks.Range("A1").End(xlDown)
    If rng.Text Like "-*" Then
        rng.EntireRow.Delete
        Set rng = wks.UsedRange
    End If
    '    Application.ScreenUpdating = False

    'sort by the date value column
    rng.Sort key1:=wks.Cells(1, DelAGIDateCol), Header:=xlYes
    Set rng = rng.Columns(DelAGIDateCol)

    On Error Resume Next
    With rng
        Set FirstYesterdayCell = .Find(What:=CStr(dtToday - 1), After:=.Cells(1, 1), LookIn:=xlFormulas _
                                                                                             , LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
                                       MatchCase:=False, SearchFormat:=False)

        Set FirstTodayCell = .Find(What:="27/12/2013", After:=.Cells(1, 1), LookIn:=xlFormulas _
                                                                                    , LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
                                   MatchCase:=False, SearchFormat:=False)

        Set FirstBlankCell = .Find(What:="          ", After:=.Cells(1, 1), LookIn:=xlFormulas _
                                                                                    , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
                                   MatchCase:=False, SearchFormat:=False)

    End With
    On Error GoTo 0

    Select Case True
        Case Not FirstYesterdayCell Is Nothing
            lngEndRow = FirstYesterdayCell.Row
        Case Not FirstTodayCell Is Nothing
            lngEndRow = FirstTodayCell.Row
        Case Not FirstBlankCell Is Nothing
            lngEndRow = FirstBlankCell.Row
        Case Else
            lngEndRow = rng.Rows.Count
    End Select
    Set rng = wks.Range(wks.Rows(2), wks.Rows(lngEndRow))


    '    DelAGIDateArr = rng.Columns(DelAGIDateCol)
    '    Set rng = Nothing
    '    Stop
    '    'iterate the AG cells from bottom to top, to identify a single range for deletion.
    '    'with dates <> yesterday or today
    '    lngEndRow = UBound(DelAGIDateArr)
    '    For lngLoop = UBound(DelAGIDateArr) To (LBound(DelAGIDateArr)) Step -1
    '        Select Case DelAGIDateArr(lngLoop, 1)
    '            Case dtToday - 1 To dtToday, "          "
    '                'keep looping
    '            Case Else
    '                lngEndRow = lngLoop
    '                Exit For
    '        End Select
    '    Next lngLoop
    '    Set rng = wks.Range(wks.Rows(2), wks.Rows(lngEndRow))
    '    Application.StatusBar = "Deleted rows: " & rng.Address
    rng.Delete

    'sort by column 1
    wks.Range("A1").CurrentRegion.Sort key1:=wks.Cells(1, 1), Header:=xlYes

    '   Application.ScreenUpdating = True
    '    Application.StatusBar = vbNullString
    'wks.UsedRange.AutoFilter Field:=DelAGIDateCol, Criteria1:=">=" & Format(dtToday - 1, "dd Mmm yyyy"), Operator:=xlAnd, Criteria2:="<=" & Format(dtToday, "dd Mmm yyyy")
    wks.UsedRange.AutoFilter Field:=DelAGIDateCol, Criteria1:="<>          "
    '   Call ToggleRefreshXlApp(True)
End Sub

Sub ToggleRefreshXlApp(RefreshAppSettings As Boolean, Optional ByRef xlApp As Excel.Application)
    If xlApp Is Nothing Then
        Set xlApp = Excel.Application
    End If
    With xlApp
        If Not RefreshAppSettings Then
            glb_origCalculationMode = .Calculation
            glb_origStatusBar = .StatusBar
        End If
        .EnableEvents = RefreshAppSettings
        On Error Resume Next
        '        .Calculation = IIf(RefreshAppSettings, glb_origCalculationMode, xlCalculationManual)
        .Calculation = IIf(RefreshAppSettings, xlCalculationAutomatic, xlCalculationManual)
        On Error GoTo 0
        .StatusBar = IIf(RefreshAppSettings, vbNullString, CBool(glb_origStatusBar))
        .ScreenUpdating = RefreshAppSettings
    End With
    Set xlApp = Nothing
End Sub

Open in new window


The following "shared" code has been uploaded before & it may be useful for learning from too. Hopefully the weather stays okay & I haven't missed any supporting code.

Option Explicit
Public glb_origCalculationMode As Long
Public glb_origStatusBar As String
Sub RefreshXlApp()
    With Application
        .EnableEvents = True
        On Error Resume Next
        .Calculation = xlCalculationAutomatic
        On Error GoTo 0
        .StatusBar = False
        .ScreenUpdating = True
        .DisplayFormulaBar = True
        .ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
    End With
End Sub
Sub ToggleRefreshXlApp(RefreshAppSettings As Boolean, Optional ByRef xlApp As Excel.Application)
    If xlApp Is Nothing Then
        Set xlApp = Excel.Application
    End If
    With xlApp
        If Not RefreshAppSettings Then
            glb_origCalculationMode = .Calculation
            glb_origStatusBar = .StatusBar
        End If
        .EnableEvents = RefreshAppSettings
        On Error Resume Next
        '        .Calculation = IIf(RefreshAppSettings, glb_origCalculationMode, xlCalculationManual)
        .Calculation = IIf(RefreshAppSettings, xlCalculationAutomatic, xlCalculationManual)
        On Error GoTo 0
        .StatusBar = IIf(RefreshAppSettings, vbNullString, CBool(glb_origStatusBar))
        .ScreenUpdating = RefreshAppSettings
    End With
    Set xlApp = Nothing
End Sub

Open in new window


hth
Rob
aikimark

@Rob

The AG column was treated as text in my environment, so I couldn't approach the solution with as many paths as you.  Thank you for doing that performance testing.