Row Deletion w/ VBA

[wljudd]

I am trying to write a VBA that deletes the Row if column U = "Delivered". Column U is an index/match function pulling from another workbook and I've added the text function but I still keep running into the same error of no match. Any additional conversions I put into the VBA really slows down the running of it because it is going from line to line and there are like 40,000 lines. Is there a better way I could be doing this.Here is that code below and a sample file attached.

Sub deleteRows()

Dim lastRow As Long
Dim i As Long

lastRow = Cells(Rows.Count, "U").End(xlUp).Row

For i = lastRow To 1 Step -1
If Cells(i, "U").Value = "Delivered" Then
Rows(i).Delete
End If
Next i

End Sub

[ranman256]

how about:

Dim lastRow, i

On Error Resume Next

lastRow = ActiveSheet.UsedRange.Rows.Count
Range("U" & lastRow).Select

For i = lastRow To 1 Step -1
   If ActiveCell.Value = "Delivered" Then Rows(i).Delete
   ActiveCell.Offset(-1, 0).Select
Next
MsgBox "Done"

[BadlySpelledBuoy]

Try this, without the need to loop through row by row.

Sub DelDeliveredRows()
    Application.DisplayAlerts = False
    With ThisWorkbook.Sheets("Sheet1").ListObjects(1)
         .Range.AutoFilter Field:=21, Criteria1:="Delivered"
         .DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
         .Range.AutoFilter
    End With
    Application.DisplayAlerts = True
End Sub

Or this if there's a chance no rows will be "Delivered"

Sub DelDeliveredRows()
    Application.DisplayAlerts = False
    With ThisWorkbook.Sheets("Sheet1").ListObjects(1)
         .Range.AutoFilter Field:=21, Criteria1:="Delivered"
         On Error Resume Next
         .DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
         On Error GoTo 0
         .Range.AutoFilter
    End With
    Application.DisplayAlerts = True
End Sub

BSB

[wljudd]

The first one seemed to work. I'll keep testing it but thank you!

[Sintek]

Another Option...

Sub J3v16()
With ActiveSheet.ListObjects(1).DataBodyRange.Columns(21)
    .Value = Evaluate("=If(Row(" & .Address & "),If(" & .Address & "=""Delivered"",""""," & .Address & "))")
    .SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
End With
End Sub