delete row (range) if Zero found

[redspanna]

Hi all

NAME	PROFIT	W	L	WIN %
DAVE	34.75	1	0	1
TIM	0	0	0	0
KEVIN	0	0	0	0
PETER	0	0	0	0
ALAN	0	0	0	0
PAUL	-9.84	0	1	0

Simple enough but can't get to VBA to work
Simply look through range B3:B8 and if a Zero is found then remove (Delete and move up) all data in corresponding rows A:E
so for example if a zero is found (as shown in B4) then A4:E4 is deleted (and moved up)

TIA

 

[kevin9999]

There's a number of different ways you could do this; here's one:

Sub ZapZeroes()
    With ActiveSheet
        If .AutoFilterMode Then .AutoFilter.ShowAllData
        With .Range("A1").CurrentRegion
            .AutoFilter 2, "0"
            If .SpecialCells(xlCellTypeVisible).Address <> .Rows(1).Address Then
                .Offset(1).Resize(, 5).Delete shift:=xlUp
            End If
            .AutoFilter
        End With
    End With
End Sub

 

[redspanna]

There's a number of different ways you could do this; here's one:

Sub ZapZeroes()
    With ActiveSheet
        If .AutoFilterMode Then .AutoFilter.ShowAllData
        With .Range("A1").CurrentRegion
            .AutoFilter 2, "0"
            If .SpecialCells(xlCellTypeVisible).Address <> .Rows(1).Address Then
                .Offset(1).Resize(, 5).Delete shift:=xlUp
            End If
            .AutoFilter
        End With
    End With
End Sub

Cheers Kevin for the reply
Didn't think it would cause an issue but in columns AB I have a pivot so I'm getting an error with this line of the code

.Offset(1).Resize(, 5).Delete shift:=xlUp

as the removal of the zero data will affect the pivot (the error is saying)

 

[kevin9999]

Understood. Give this a try instead and see if it works for you:

Sub ZapZeroes2()
    Dim LRow As Long, i As Long
    LRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = LRow To 2 Step -1
        If Cells(i, 2) = "0" Then
            Range(Cells(i, 1), Cells(i, 5)).Delete Shift:=xlUp
        End If
    Next i
End Sub

 

[redspanna]

Understood. Give this a try instead and see if it works for you:

Sub ZapZeroes2()
    Dim LRow As Long, i As Long
    LRow = Cells(Rows.Count, 1).End(xlUp).Row
   
    For i = LRow To 2 Step -1
        If Cells(i, 2) = "0" Then
            Range(Cells(i, 1), Cells(i, 5)).Delete Shift:=xlUp
        End If
    Next i
End Sub

OK, getting there
If I were to have the table of data starting in cell O1 (instead of A1) would I change your code to below...

Sub ZapZeroes2()
    Dim LRow As Long, i As Long
    LRow = Cells(Rows.Count, 15).End(xlUp).Row
    
    For i = LRow To 2 Step -1
        If Cells(i, 16) = "0" Then
            Range(Cells(i, 15), Cells(i, 5)).Delete Shift:=xlUp
        End If
    Next i
End Sub

 

[kevin9999]

Almost perfect!

Sub ZapZeroes2()
    Dim LRow As Long, i As Long
    LRow = Cells(Rows.Count, 15).End(xlUp).Row
    
    For i = LRow To 2 Step -1
        If Cells(i, 16) = "0" Then
            Range(Cells(i, 15), Cells(i, 19)).Delete Shift:=xlUp
        End If
    Next i
End Sub

 

[redspanna]

Almost perfect!

Sub ZapZeroes2()
    Dim LRow As Long, i As Long
    LRow = Cells(Rows.Count, 15).End(xlUp).Row
   
    For i = LRow To 2 Step -1
        If Cells(i, 16) = "0" Then
            Range(Cells(i, 15), Cells(i, 19)).Delete Shift:=xlUp
        End If
    Next i
End Sub

Fantastic - perfect

Thanks a lot
Have a great weekend

 

[kevin9999]

Happy to help, and thanks for the feedback