If there is a 0 in column K, delete rows C to K and shift cells up

Question

I have a code that looks at Column K, checks if there is a 0 and if there is, it deletes the corresponding rows from C to K.

Sub del()


Application.ScreenUpdati         


        

Answer 1

You can reduce that loop to a simple filter and delete. Note this is deleting the entire row so this may need some modification on your end to suit your needs

Sub del()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Formations_Tracker")
Dim LR As Long
Dim DeleteMe As Range

LR = ws.Range("K" & ws.Rows.Count).End(xlUp).Row

Application.DisplayAlerts = False

    ws.Range("C1:K" & LR).AutoFilter Field:=9, Criteria1:=0
    Set DeleteMe = ws.Range("C2:K" & LR).SpecialCells(xlCellTypeVisible)
    ws.AutoFilterMode = False
    If Not DeleteMe Is Nothing Then DeleteMe.Delete (xlShiftUp)

Application.DisplayAlerts = True

End Sub