Case loop terminates before deleting all values

Question

I am new to VBA and I am trying to get my code to loop through about 10,000 lines of integers in row K and delete rows based on values, my code works but will only do small parts at a time. Please advise.

'Delete unwanted accounts
Dim Lcell As Long
Application.ScreenUpdating = False
Lcell = TransSheet.Cells(Rows.Count, "K").End(xlUp).Row
For a = 1 To Lcell Step 1
   Select Case Cells(a, 11).Value
      Case "1200", "652", "552"
         Cells(a, 11).EntireRow.Delete
   End Select
Next a
Application.ScreenUpdating = True

Answer 1

Try from the last row to the first one. You are deleting rows so your numbering is being thrown off:

'Delete unwanted accounts
Dim Lcell As Long
Application.ScreenUpdating = False
Lcell = TransSheet.Cells(Rows.Count, "K").End(xlUp).Row
For a = Lcell To 1 Step -1
   Select Case Cells(a, 11).Value
      Case "1200", "652", "552"
         Cells(a, 11).EntireRow.Delete
   End Select
Next a
Application.ScreenUpdating = True

Answer 2

You can perform a single delete on all the identified rows:

'Delete unwanted accounts
Dim rngDel as range
Dim Lcell As Long, v

Lcell = TransSheet.Cells(Rows.Count, "K").End(xlUp).Row

For a = 1 To Lcell 
   v = Cells(a, 11).Value
    If v = "1200" or v = "652" or v = "552" Then
        If Not rngDel is Nothing Then
            Set rngDel = Application.Union(rngDel, Cells(a, 11).EntireRow)
        Else
            Set rngDel = Cells(a, 11).EntireRow    
        End If
    End If
Next a

If Not rngDel Is Nothing Then rngDel.Delete

Answer 3

Add this line to your code

Cells(a, 11).EntireRow.Delete
a = a - 1

This will take care of the shifting that occurs because the row disappears.

---

On a side note, I personally use the following method to delete multiple rows. e.g. the rows I want to delete are stored in an Variant array DelRows(). You may obtain them dynamically at run-time. Here I manually assign some random rows.

Sub DeleteRows()
    Dim DelRows() As Variant
    ReDim DelRows(1 To 3)

    DelRows(1) = 15
    DelRows(2) = 18
    DelRows(3) = 21

    '--- How to delete them all together?

    Dim i As Long
    For i = LBound(DelRows) To UBound(DelRows)
        DelRows(i) = DelRows(i) & ":" & DelRows(i)
    Next i

    Dim DelStr As String
    DelStr = Join(DelRows, ",")

    ' DelStr = "15:15,18:18,21:21"

    ActiveSheet.Range(DelStr).Delete
End Sub