Code sorts but is slow

OfficeUser

Well-known Member
Joined
Feb 4, 2010
Messages
544
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I use this code to filter out any dates outside of the range I place on the userform this code is part of. Anyone have any suggestions to speed it up. The dates I filter start in 06' I would only need dates from 10' on. Perhaps I could dump those rows first. Thoughts? Thanks!!

Code:
Sub DateRangeSort()
Application.ScreenUpdating = False
Sheets("Sheet1").Select
Dim DT As Date: Dim DTT As Date
DT = UserForm1.TextBox4.Text 'UserformDate
DTT = UserForm1.TextBox5.Text
a = 1
st:
If Cells(a, 1) = "" Then GoTo endd
If Cells(a, 1) <= DTT And Cells(a, 1) >= DT Then a = a + 1: GoTo st
Cells(a, 1).Select
Selection.EntireRow.Delete
GoTo st
endd:
Application.ScreenUpdating = True
End Sub
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
If there are many rows to delete, you might want to try deleting them all in one shot rather than one at a time. Like this:
Code:
Sub DateRangeSort()
Dim DT As Date, DTT As Date, lRw As Long, dRng As Range
Sheets("Sheet1").Select
With Application
    .ScreenUpdating = False
End With
DT = UserForm1.TextBox4.Text 'UserformDate
DTT = UserForm1.TextBox5.Text
lRw = Range("A" & Rows.Count).End(xlUp).Row
For a = 1 To lRw
    If Cells(a, 1) = "" Then Exit Sub
    If Cells(a, 1) >= DTT Or Cells(a, 1) <= DT Then
        If dRng Is Nothing Then
            Set dRng = Rows(a)
        Else
            Set dRng = Union(dRng, Rows(a))
        End If
    End If
Next a
If dRng Is Nothing Then
    MsgBox "No dates outside of range"
Else
    dRng.Delete
End If
End Sub
 
Upvote 0
This uses Autofilter to select the date range and then deletes the rows all at once. Cell A1 is considered a header.

Code:
Sub DateRangeSort()
    Dim DT As Date, DTT As Date
    Dim LR As Long, rng As Range
    
    DT = CDate(UserForm1.TextBox4.Text)    'UserformDate
    DTT = CDate(UserForm1.TextBox5.Text)
    
    Application.ScreenUpdating = False
    With Sheets("Sheet1")
        LR = .Range("A" & Rows.Count).End(xlUp).Row    'last used row
        .Range("A1:A" & LR).AutoFilter Field:=1, Criteria1:=">=" & DT, _
                                       Operator:=xlAnd, Criteria2:="<=" & DTT
        On Error Resume Next
        Set rng = .Range("A2:A" & LR).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If Not rng Is Nothing Then rng.EntireRow.Delete
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
AlphaFrog: Your code worked but deleted the date range and kept everything else.

JoeMo: Your code did the job but if I put in a range of 9/1/11 to 9/30/11 it showed me 9/2/11 to 9/29/11.

Thanks!!
 
Upvote 0
AlphaFrog: Your code worked but deleted the date range and kept everything else.

This would do the opposite.

Code:
        .Range("A1:A" & LR).AutoFilter Field:=1, Criteria1:="[COLOR="Red"]<[/COLOR]=" & DT, _
                                       Operator:=[COLOR="Red"]xlOr[/COLOR], Criteria2:="[COLOR="Red"]>[/COLOR]=" & DTT
 
Upvote 0
Yea, I figured that out right after I posted. I also altered the other to work. Both work well now. Thank you both for your help.
 
Upvote 0
AlphaFrog: Your code worked but deleted the date range and kept everything else.

JoeMo: Your code did the job but if I put in a range of 9/1/11 to 9/30/11 it showed me 9/2/11 to 9/29/11.

Thanks!!
If you want to keep dates that correspond to either DT or DTT then just remove the = signs from the line:
Rich (BB code):
If Cells(a, 1) >= DTT Or Cells(a, 1) <= DT Then
 
Upvote 0

Forum statistics

Threads
1,223,170
Messages
6,170,473
Members
452,330
Latest member
AFK_Matrix

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