Delete partial row if condition met

[Pumper]

Hi All,

I am trying to loop through a list and if "Cash" is found in Column B then from cell A to H of that row is deleted (then shifted up)

This code will work but deletes the entire row which is not what I am after, any help would be much appreciated!

Sub DeleteCash()

Last = Cells(rows.Count, "B").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "B").value) = "CASH" Then
Cells(i, "B").EntireRow.Delete
End If
Next i

End Sub

 

[DanteAmor]

Try this:

Sub DeleteCash()
  Dim i As Long, last As Long
  
  last = Cells(Rows.Count, "B").End(xlUp).Row
  For i = last To 1 Step -1
    If (Cells(i, "B").Value) = "CASH" Then
      Range("A" & i & ":H" & i).Delete Shift:=xlUp
    End If
  Next i
End Sub

 

[Pumper]

Try this:

Sub DeleteCash()
  Dim i As Long, last As Long
 
  last = Cells(Rows.Count, "B").End(xlUp).Row
  For i = last To 1 Step -1
    If (Cells(i, "B").Value) = "CASH" Then
      Range("A" & i & ":H" & i).Delete Shift:=xlUp
    End If
  Next i
End Sub

Thanks Dante!

It works, takes a long time to run but I am guessing looping through everything then shifting up is the reason.

Much appreciated

 

[DanteAmor]

Turn off screen updating, it should improve a bit:

Sub DeleteCash()
  Dim i As Long, last As Long
 
  Application.ScreenUpdating = False
  last = Cells(Rows.Count, "B").End(xlUp).Row
  For i = last To 1 Step -1
    If (Cells(i, "B").Value) = "CASH" Then
      Range("A" & i & ":H" & i).Delete Shift:=xlUp
    End If
  Next i
  Application.ScreenUpdating = True
End Sub

How many records do you have on your sheet?
Do you have formulas in cells?
You could try with arrays, it's certainly faster:

 

[Pumper]

Turn off screen updating, it should improve a bit:

Sub DeleteCash()
  Dim i As Long, last As Long
 
  Application.ScreenUpdating = False
  last = Cells(Rows.Count, "B").End(xlUp).Row
  For i = last To 1 Step -1
    If (Cells(i, "B").Value) = "CASH" Then
      Range("A" & i & ":H" & i).Delete Shift:=xlUp
    End If
  Next i
  Application.ScreenUpdating = True
End Sub

How many records do you have on your sheet?
Do you have formulas in cells?
You could try with arrays, it's certainly faster.

Only 130 rows and no formulas

Tiny bit faster not really noticeable.

Thanks again for your time

 

[DanteAmor]

Only 130 rows and no formulas

Tiny bit faster not really noticeable.

Thanks again for your time

Try:

Sub DeleteCash_v2()
  Dim i As Long, j As Long, k As Long
  Dim a As Variant, b As Variant
  
  a = Range("A1:H" & Range("B" & Rows.Count).End(xlUp).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  For i = 1 To UBound(a, 1)
    If a(i, 2) <> "CASH" Then
      k = k + 1
      For j = 1 To UBound(a, 2)
        b(k, j) = a(i, j)
      Next
    End If
  Next i
  
  Range("A1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

 

[Pumper]

Try:

Sub DeleteCash_v2()
  Dim i As Long, j As Long, k As Long
  Dim a As Variant, b As Variant
 
  a = Range("A1:H" & Range("B" & Rows.Count).End(xlUp).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  For i = 1 To UBound(a, 1)
    If a(i, 2) <> "CASH" Then
      k = k + 1
      For j = 1 To UBound(a, 2)
        b(k, j) = a(i, j)
      Next
    End If
  Next i
 
  Range("A1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

WOW! that is super fast and does the job.

Thanks so much for solving this, was driving me crazy.