Quick question to save everybody's time:

I have the code below that works fine but is too slow for my 30,000 lines.

It basically deletes all the rows not containing the states TX, AR, LA and OK from column AD.

Sub DeleteStateExceptions()
    Dim iLastRow As Long
    Dim i As Long
    iLastRow = Cells(Rows.Count, "AD").End(xlUp).Row
    For i = iLastRow To 2 Step -1
        Select Case Cells(i, "AD").Value
            Case "TX"
            Case "OK"
            Case "AR"
            Case "LA"
            Case Else
                Rows(i).Delete
            End Select
    Next i
    'deletes row when cell in column AD is not TX, OK, AR or LA
End Sub

Any amendment to make it faster? Would you use a different logic?

CodePudding user response：

Please, try the next updated code. It should be very fast:

Sub DeleteStateExceptions()
    Dim iLastRow As Long, arrMark, lastEmptyCol As Long, i As Long, boolDel As Boolean
    iLastRow = cells(rows.count, "AD").End(xlUp).Row
    lastEmptyCol = ActiveSheet.UsedRange.Column   ActiveSheet.UsedRange.Columns.count   1
    ReDim arrMark(1 To iLastRow - 1, 1 To 1)
    For i = 2 To iLastRow
        Select Case cells(i, "AD").value
            Case "TX", "OK", "AR", "LA"
            Case Else
                boolDel = True  'to delete only if at least a row has been marked
                arrMark(i - 1, 1) = "Del"
            End Select
    Next i
    If boolDel Then
        With cells(2, lastEmptyCol).Resize(UBound(arrMark), 1)
            .value = arrMark
            .SpecialCells(xlCellTypeConstants).EntireRow.Delete
        End With
    End If
End Sub

An alternative would be to create a Union range, but in case of large ranges, creating of this one slows down the speed seriously. You can set a maximum cells limit (iterate backwards), let us say, 100, delete the rows already in the Union range and set it as Nothing.

But the above solution should be the fastest, in my opinion...