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.ScreenUpdating = False 'Prevent screen flickering
Application.Calculation = xlCalculationManual 'Preventing calculation

Dim sh As Worksheet, lr As Long, i As Long, lngStartRow As Long

Set sh = Sheets("Formations_Tracker")
lr = sh.Cells(Rows.Count, "C").End(xlUp).Row
lngStartRow = 2 'Starting data row number.

For i = lr To lngStartRow Step -1
    If sh.Cells(i, "K") = 0 Then
        sh.Cells(i, "K").Resize(1, 2).Delete Shift:=xlUp
        sh.Cells(i, "J").Resize(1, 2).Delete Shift:=xlUp
        sh.Cells(i, "I").Resize(1, 2).Delete Shift:=xlUp
        sh.Cells(i, "H").Resize(1, 2).Delete Shift:=xlUp
        sh.Cells(i, "G").Resize(1, 2).Delete Shift:=xlUp
        sh.Cells(i, "F").Resize(1, 2).Delete Shift:=xlUp
        sh.Cells(i, "E").Resize(1, 2).Delete Shift:=xlUp
        sh.Cells(i, "D").Resize(1, 2).Delete Shift:=xlUp
        sh.Cells(i, "C").Resize(1, 2).Delete Shift:=xlUp
    End If
Next i

Set sh = Nothing

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

The issue is this works if the last row is the one that contains a 0. However if it's not the last row, it seems to be deleting more rows, even the ones that don't have 0s in them.

You can delete the entire row with `sh.Range(sh.Cells(i, "C"), sh.Cells(i, "K")).Delete`. A even better alternative would be to just filter `COlumn K` for `0` and then delete the resulting range. No loop needed here — urdearboy, Feb 12 '20 at 15:58

urdearboy · Accepted Answer · 2020-02-12T20:11:25.113

3

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

edited Feb 12 '20 at 20:11

answered Feb 12 '20 at 16:03

urdearboy

14,439
5
28
58

It still asks me if I want to delete the entire row. `ws.Range("C1:K" & lr).AutoFilter Field:=9, Criteria1:="0"` `ws.Range("C1:K" & lr).Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Delete` – Jade Feb 12 '20 at 19:47
I don't want the whole row to be deleted, only from C to K – Jade Feb 12 '20 at 19:51
This is what I did, see my first reply – Jade Feb 12 '20 at 19:57
I have tried this as well, see my first reply, it still deletes the whole row. – Jade Feb 12 '20 at 20:02
See code as of now. Made edits - tested and working as expected. – urdearboy Feb 12 '20 at 20:17

score 1 · Answer 2 · answered Feb 12 '20 at 16:04

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

Turns out there is no need to set your objects equal to nothing here via [this](https://stackoverflow.com/questions/51065566/what-are-the-benefits-of-setting-objects-to-nothing) old post of mine — urdearboy, Feb 12 '20 at 16:05
I've seen that setting my class objects to nothing actually free up some memory, or even erasing arrays that are so big. What I can't actually shake is freeing memory after filtering huge olap cubes... — Damian, Feb 12 '20 at 16:23

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

2 Answers2