VBA Code for Nested If Then ElseIf statement not performing each condition

[larryb43]

I'm a novice VBA user with a Macro I built to search down the "A" column starting with cell A3 and if a Technician's number meets the criteria listed, delete the entire row, then shift the rows up. I can't get it to catch all the criteria. If I step into the Macro and run the code manually about four times, it catches all the conditions. I'm obviously doing something wrong. I have verified that the cells in this column are formatted as numbers with no decimals. Can someone please help point out the error in my logic? Eager to learn Here's my code:

Sub SubShopTechs()
' TPRShopTechs Macro
Dim LastRow As Long, c As Range
Application.EnableEvents = False
	LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
	On Error Resume Next
	For Each c In Range("A3:A" & LastRow)
		If c.Value = 413 Then
			c.EntireRow.Delete shift:=xlUp
     		ElseIf c.Value = 417 Then
			c.EntireRow.Delete shift:=xlUp
     		ElseIf c.Value = 425 Then
			c.EntireRow.Delete shift:=xlUp
     		ElseIf c.Value = 431 Then
			c.EntireRow.Delete shift:=xlUp
     		ElseIf c.Value = 434 Then
			c.EntireRow.Delete shift:=xlUp
     		ElseIf c.Value = 436 Then
			c.EntireRow.Delete shift:=xlUp
     		ElseIf c.Value = 438 Then
			c.EntireRow.Delete shift:=xlUp
     		ElseIf c.Value = 439 Then
			c.EntireRow.Delete shift:=xlUp
     		ElseIf c.Value = 440 Then
			c.EntireRow.Delete shift:=xlUp
     		ElseIf c.Value = 441 Then
			c.EntireRow.Delete shift:=xlUp
     		ElseIf c.Value = 442 Then
			c.EntireRow.Delete shift:=xlUp
     		ElseIf c.Value = 511 Then
			c.EntireRow.Delete shift:=xlUp
     		ElseIf c.Value = 536 Then
			c.EntireRow.Delete shift:=xlUp
     		ElseIf c.Value = 541 Then
			c.EntireRow.Delete shift:=xlUp
		End If
	Next c
	On Error GoTo 0
Application.EnableEvents = True
End Sub

 

[RatExcel]

Try:

Sub removerows()
  
  Dim cltVal As New Collection
  
  On Error Resume Next
    cltVal.Add 413, "413"
    cltVal.Add 417, "417"
    cltVal.Add 425, "425"
    cltVal.Add 431, "431"
    cltVal.Add 434, "434"
    cltVal.Add 436, "436"
    cltVal.Add 438, "438"
    cltVal.Add 439, "439"
    cltVal.Add 440, "440"
    cltVal.Add 441, "441"
    cltVal.Add 442, "442"
    cltVal.Add 511, "511"
    cltVal.Add 536, "536"
    cltVal.Add 541, "541"
    'add new values here if needed
    'key (2nd value) must be string
  On Error GoTo 0
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  lRow = Cells(Rows.Count, "A").End(xlUp).Row
  
  For i = lRow To 3 Step -1
    On Error Resume Next
      cltVal.Add Cells(i, "A").Value, CStr(Cells(i, "A").Value)
      If Err.Number <> 0 Then
        Rows(i).Delete
      End If
    On Error GoTo 0
  Next i
  
  Set cltVal = Nothing

  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  
End Sub

 

[larryb43]

Try:

Sub removerows()
  
  Dim cltVal As New Collection
  
  On Error Resume Next
    cltVal.Add 413, "413"
    cltVal.Add 417, "417"
    cltVal.Add 425, "425"
    cltVal.Add 431, "431"
    cltVal.Add 434, "434"
    cltVal.Add 436, "436"
    cltVal.Add 438, "438"
    cltVal.Add 439, "439"
    cltVal.Add 440, "440"
    cltVal.Add 441, "441"
    cltVal.Add 442, "442"
    cltVal.Add 511, "511"
    cltVal.Add 536, "536"
    cltVal.Add 541, "541"
    'add new values here if needed
    'key (2nd value) must be string
  On Error GoTo 0
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  lRow = Cells(Rows.Count, "A").End(xlUp).Row
  
  For i = lRow To 3 Step -1
    On Error Resume Next
      cltVal.Add Cells(i, "A").Value, CStr(Cells(i, "A").Value)
      If Err.Number <> 0 Then
        Rows(i).Delete
      End If
    On Error GoTo 0
  Next i
  
  Set cltVal = Nothing

  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  
End Sub

That worked like a charm RatExcel, I really appreciate it! I need to study your code to understand what it's doing. Like I said, I'm eager to learn more.