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

Answer 2

Here is another approach:

Option Explicit
Sub del()

    Application.ScreenUpdating = False 'Prevent screen flickering
    Application.Calculation = xlCalculationManual 'Preventing calculation

    'you should also reference the workbook
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Formations_Tracker")
    'ThisWorkbook refers to the workbook which contains the code

    Dim lngStartRow As Long
    lngStartRow = 2 'Starting data row number.

    Dim lr As Long
    lr = sh.Cells(Rows.Count, "C").End(xlUp).Row

    'When looping through cells is always better to use the For Each
    Dim C As Range

    'It would be wise to delete everything at once using a range to delete
    Dim DelRange As Range

    For Each C In sh.Range("K" & lngStartRow & ":K" & lr)
        If C = 0 Then
            If DelRange Is Nothing Then
                Set DelRange = C
            Else
                Set DelRange = Union(DelRange, C)
            End If
        End If
    Next C

    'Delete all your rows at once if there is a match
    If Not DelRange Is Nothing Then DelRange.EntireRow.Delete
    Set sh = Nothing
    Set DelRange = Nothing

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub