Removing Values in Multiple Columns

Question

I need some help with creating a vba code that delete the entire row if the value of one cell in column L is equal to zero and if the value on the cell on its left which in the column K is also zero or blank. On the other hand, if the value of one cell in column L is equal to zero and if the value on the cell on its left is not equal to zero or blank, just proceed to deleting the zero value in Column L. Also, if one cell in column G is equal to zero also delete the entire row, if it's equal to blank or not equal to zero then do nothing. Kindly see below for my code. I honestly don't know how to put the second condition and third condition.

Any help will be highly appreciated.

    Dim i As Long, n As Long
    Dim rg1 As Range, rg2 As Range, rg3 As Range
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("File Source")

       Application.ScreenUpdating = False
       With ActiveSheet

       Set rg1 = Intersect(.UsedRange, .Columns("K"))
       Set rg2 = Intersect(.UsedRange, .Columns("L"))
          n = rg1.Rows.Count
          n2= rg2.Rows.Count        
          For i = n To 1 Step -1
          For i2 = n2 To 1 Step -1

        If Not IsError(rg2.Cells(i2, 1).Value) Then
            If rg2.Cells(i2, 1).Value = 0 And rg1.Cells(i, 1).Value = 0 or "" Then          rg2.Rows(i2).EntireRow.Delete

        End If
       
    Next
    
   End With

MsgBox "Zero Values Removed", vbInformation

End Sub

Answer 1

• Use a nested If clause
• For a single column range, .Cells(i,1) is equalient to .Cells(i)

Option Explicit
Sub Demo()
    Dim i As Long, n As Long
    Dim rg1 As Range, rg2 As Range
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("File Source")
    Application.ScreenUpdating = False
    With ActiveSheet
        Set rg1 = Intersect(.UsedRange, .Columns("K"))
        Set rg2 = Intersect(.UsedRange, .Columns("L"))
    End With
    n = rg1.Rows.Count
    For i = n To 1 Step -1
        If rg2.Cells(i).Value = 0 Then
            If rg1.Cells(i).Value = 0 Or Len(rg1.Cells(i).Value) = 0 Then
                rg1.Cells(i).EntireRow.Delete
            Else
                rg2.Cells(i).Value = ""
            End If
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Zero Values Removed", vbInformation
End Sub

---

• If there's a large dataset on the sheet, it's more efficient to collect all cells and apply changes all at once.

Sub Demo2()
    Dim i As Long, n As Long
    Dim rg1 As Range, rg2 As Range
    Dim resetRng As Range, delRowRng As Range
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("File Source")
    Application.ScreenUpdating = False
    With ActiveSheet
        Set rg1 = Intersect(.UsedRange, .Columns("K"))
        Set rg2 = Intersect(.UsedRange, .Columns("L"))
    End With
    n = rg1.Rows.Count
    For i = n To 1 Step -1
        If rg2.Cells(i).Value = 0 Then
            If rg1.Cells(i).Value = 0 Or Len(rg1.Cells(i).Value) = 0 Then
                If delRowRng Is Nothing Then
                    Set delRowRng = rg1.Cells(i)
                Else
                    Set delRowRng = Application.Union(delRowRng, rg1.Cells(i))
                End If
            Else
                If resetRng Is Nothing Then
                    Set resetRng = Cells(i)
                Else
                    Set resetRng = Application.Union(resetRng, rg2.Cells(i))
                End If
            End If
        End If
    Next
    If delRowRng Is Nothing Then
        delRowRng.EntireRow.Delete
    End If
    If resetRng Is Nothing Then
        resetRng.Value = ""
    End If
    Application.ScreenUpdating = True
    MsgBox "Zero Values Removed", vbInformation
End Sub

---

Update:

Question: if I would like to add one more condition where in if the one cell in column G is equal to zero then also delete the entire row. However, if one cell in column G is blank then do nothing

Sub Demo3()
    Dim i As Long, n As Long
    Dim rg1 As Range, rg2 As Range, rg0 As Range ' **
    Dim resetRng As Range, delRowRng As Range
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("File Source")
    Application.ScreenUpdating = False
    With ActiveSheet
        Set rg0 = Intersect(.UsedRange, .Columns("G"))
        Set rg1 = Intersect(.UsedRange, .Columns("K"))
        Set rg2 = Intersect(.UsedRange, .Columns("L"))
    End With
    n = rg1.Rows.Count
    For i = n To 1 Step -1
        If rg0.Cells(i).Text = 0 Then
            If delRowRng Is Nothing Then
                Set delRowRng = rg1.Cells(i)
            Else
                Set delRowRng = Application.Union(delRowRng, rg1.Cells(i))
            End If 
        End If
        If rg2.Cells(i).Value = 0 Then
            If rg1.Cells(i).Value = 0 Or Len(rg1.Cells(i).Value) = 0 Then
                If delRowRng Is Nothing Then
                    Set delRowRng = rg1.Cells(i)
                Else
                    Set delRowRng = Application.Union(delRowRng, rg1.Cells(i))
                End If
            ElseIf Len(rg1.Cells(i).Value) > 0 Then
                If resetRng Is Nothing Then
                    Set resetRng = rg2.Cells(i)
                Else
                    Set resetRng = Application.Union(resetRng, rg2.Cells(i))
                End If
            End If
        End If
    Next
    If Not delRowRng Is Nothing Then
        delRowRng.EntireRow.Delete
    End If
    If Not resetRng Is Nothing Then
        resetRng.Value = ""
    End If
    Application.ScreenUpdating = True
    MsgBox "Zero Values Removed", vbInformation
End Sub