VBA Faster Way to Delete

[Stephen_IV]

Good afternoon,

I am trying to delete a range of over 150,000 rows. The code below works but takes an awful amount of time. Does anyone have any faster code? Thanks in advance Stephen!

Public Sub Makeit()
Dim sh2 As Worksheet
Set sh2 = Sheets("Sheet2")
Dim lastrow As Long
lastrow = Cells(Rows.Count, "AA").End(xlUp).row

    For i = lastrow To 2 Step -1
        If Cells(i, 27).Value <= #8/31/2017# Then
            Cells(i, 1).EntireRow.Delete
        End If
    Next
End Sub

 

[mumps]

Try filtering column 27 on dates <=8/31/2017 and then delete the visible rows.

 

[Fluff]

The quickest way would be to sort your data first.
and then as mumps has suggested use autofilter.

another option would be

Public Sub Makeit()
   Dim sh2 As Worksheet
   Set sh2 = Sheets("Sheet2")
   Dim lastrow As Long
   Dim Rng As Range

   lastrow = Cells(Rows.count, "AA").End(xlUp).Row
   
   For i = lastrow To 2 Step -1
      If Cells(i, 27).Value <= #8/31/2017# Then
         If Rng Is Nothing Then
            Set Rng = Range("A" & i)
         Else
            Set Rng = Union(Rng, Range("A" & i))
         End If
      End If
   Next
   If Not Rng Is Nothing Then Rng.EntireRow.Delete
End Sub

This will be quicker than your code, but slower than an autofilter

 

[offthelip]

I think I saw somewhere else or maybe on this forum that the fastest way of doing this, is to load column 27 into a variant array, define a variant array with the same number of rows 1 column wide. Then iterate down your column 27 array setting true or false depending on the coindition. Paste this array back to the worksheet one column beyond the last used column. Then sort the worksheet on this column so that all the "Trues" are at the bottom then delete the entire range of "trues"

 

[eikogs]

You might be able to modify this bit of code to speed things up if you do not want to rearrange your sheet. I have used a version of this for both deleting and to Hide/unhide rows and it speeds things up significantly.

Sub BatchDelete()
On Error Resume Next
Application.ScreenUpdating = False
Dim mRange As String
mRange = ""
For LinesToCheck = 1 To 1000
If Range("A" & LinesToCheck).Value Like "*DeleteMe*" Then
If mRange = "" Then
mRange = "A" & LinesToCheck
Else
mRange = mRange & ", A" & LinesToCheck
End If
End If

If Len(mRange) > 245 Or LinesToCheck = rowend Then
Set rGroup1 = Range(mRange).EntireRow
rGroup1.Delete
mRange = ""
End If

Next LinesToCheck
If mRange <> "" Then
Set rGroup1 = Range(mRange).EntireRow
rGroup1.Delete
mRange = ""
End If
On Error GoTo 0
End Sub

 

[Stephen_IV]

Thanks to all!!! I appreciate all of the replies and will try the solutions. Thank you again!

 

[Fluff]

Glad we could help.
If you encounter a problems, let us know

 

[SpillerBD]

I wonder if Sort/ filter/ clear cells/ sort again would be faster (for large selection of rows)?