delete data if the two columns contain zero together

[Hasson]

Hello
I have about 7000 rows . I search for way delete data contin zero or empty value for columns D,E together then should delete it.

orginal

DELETE2.xlsm
	A	B	C	D	E	F
1	ITEM	ID	QTY1	QTY2	QTY3	BALANCE
2	1	TT/W-1 MM CLA1 23M-1 IT	500			500
3	2	QQW-2 TH NM-1 CLA2 VBG L CHI				0
4	3	QQW-3 CV CLA3 TAI	700	33		733
5	4	QQW-4 M*12.5 CLA4 TR	200		12	188
6	5	QQW-5 CLA5 EG	300			300
7	6	MMR12/100 AS-1000/1 TMR	12	0	0	12
8	7	QQW-6 M230 TU	1			1
9	8	QQW-7 S** CLA7 US	1400		1	1399
10	9	QQW-8 CLA8 UK				0
11	10	QQW-9 CLA9 N BR	1600		1	1599
12	11	QQW-10 BN CLA10 IT	800	0	0	800
13	12	QQW-11 LVD CH	900			900
14	13	BB12 QQW-12 CLA12 JA	1000		11	989
sheet1

Cell Formulas
Range	Formula
F2:F14	F2	=C2+D2-E2

result

DELETE2.xlsm
	A	B	C	D	E	F
1	ITEM	ID	QTY1	QTY2	QTY3	BALANCE
2	1	QQW-3 CV CLA3 TAI	700	33		733
3	2	QQW-4 M*12.5 CLA4 TR	200		12	188
4	3	QQW-7 S** CLA7 US	1400		1	1399
5	4	QQW-9 CLA9 N BR	1600		1	1599
6	5	BB12 QQW-12 CLA12 JA	1000		11	989
sheet1

Cell Formulas
Range	Formula
F2:F6	F2	=C2+D2-E2

 

[Alex Blakenburg]

Are you looking for a VBA solution or just a quick fix ?

For a quick fix just filter both D & E using a custom filter.
Put equals nothing / Blank for the 1st filter then
User OR
Put in equals 0 for the second filter
Repeat on the 2nd column.

Then select all the rows and delete rows

Remove filter and renumber remaining rows.

 

[Hasson]

actually I want by vba

 

[Alex Blakenburg]

I might not get time to do it today, if no one has done it for you by tomorrow, I can look at it then.

 

[bebo021999]

Here VBA solution.
This code employ column ZZ (or any available column) to help to delete rows, then this column will be removed.

Option Explicit
Sub delete()
Dim lr&
lr = Cells(Rows.Count, "B").End(xlUp).Row
Range("ZZ2:ZZ100000").ClearContents
Range("ZZ2:ZZ" & lr).Value = Evaluate("=1/(D2:D" & lr & "+E2:E" & lr & ")")
Range("ZZ2:ZZ" & lr).SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.delete
Columns("ZZ").ClearContents
lr = Cells(Rows.Count, "B").End(xlUp).Row
Range("A2:A" & lr).Value = Evaluate("=ROW(2:" & lr & ")-1")
End Sub

P/S: it will not work, if positive in D and negative in E those make 0 in sum
might it not the actual case?

 

[Hasson]

thanks Alex I appreciate that

 

[Hasson]

@bebo021999 great !

might it not the actual case?

surely I don't have this case even that works . it stay the minus values without any problem.
las thing ,please I want keeping orginal data in sheet1 and result in sheet2
and where is the line search for empty or zero ,there is no condition in your code?

 

[kevin9999]

Try this?

Option Explicit
Sub Hasson()
    Application.ScreenUpdating = False
    Dim LRow As Long, LCol As Long, i As Long
    Dim a, b
    LRow = Cells.Find("*", , xlFormulas, , 1, 2).Row
    LCol = Cells.Find("*", , xlFormulas, , 2, 2).Column + 1
    a = Range("D2:E" & LRow)
    ReDim b(1 To UBound(a, 1), 1 To 1)
    
    For i = 1 To UBound(a)
        If a(i, 1) + a(i, 2) = 0 Then b(i, 1) = 1
    Next i
    
    Cells(2, LCol).Resize(UBound(a)) = b
    i = WorksheetFunction.Sum(Columns(LCol))
    Range(Cells(2, 1), Cells(LRow, LCol)).Sort Key1:=Cells(2, LCol), order1:=1, Header:=2
    If i > 0 Then Cells(2, LCol).Resize(i).EntireRow.Delete

    LRow = Cells.Find("*", , xlFormulas, , 1, 2).Row
    With Range("A2:A" & LRow)
        .Formula = "=Row()-1"
        .Value = .Value
    End With
    
    Application.ScreenUpdating = True
End Sub

 

[bebo021999]

@bebo021999
las thing ,please I want keeping orginal data in sheet1 and result in sheet2
and where is the line search for empty or zero ,there is no condition in your code?

If current sheet was sheet1, just add 1 line in top of code, to dupplicate new sheet, sheet2

Sheets("Sheet1").Copy after:=Sheets(Sheets.Count)

If in helper column from row 2, there is formula:
=1/(D2+E2)
you can see "#DIV/0" where D2+E2=0
and manually, you can filter this column then delete rows.

In code, with no loop, then helper column could be populated, at once, in bulk like this:

Range("ZZ2:ZZ" & lr).Value = Evaluate("=1/(D2:D" & lr & "+E2:E" & lr & ")")

Option Explicit
Sub delete()
Dim lr&
Sheets("Sheet1").Copy after:=Sheets(Sheets.Count)
lr = Cells(Rows.Count, "B").End(xlUp).Row
Range("ZZ2:ZZ100000").ClearContents
Range("ZZ2:ZZ" & lr).Value = Evaluate("=1/(D2:D" & lr & "+E2:E" & lr & ")")
Range("ZZ2:ZZ" & lr).SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.delete
Columns("ZZ").ClearContents
lr = Cells(Rows.Count, "B").End(xlUp).Row
Range("A2:A" & lr).Value = Evaluate("=ROW(2:" & lr & ")-1")
End Sub

 

[kevin9999]

I want keeping orginal data in sheet1 and result in sheet2

Adjustment to code in post #8 based on above comment.

Option Explicit
Sub Hasson_V2()
    Application.ScreenUpdating = False
    Dim LRow As Long, LCol As Long, i As Long
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    Dim a, b
    
    ws2.UsedRange.Clear
    With ws1.Range("A1").CurrentRegion
        .Copy
        ws2.Range("A1").PasteSpecial xlPasteAll
        ws2.Range("A1").PasteSpecial xlPasteColumnWidths
        .Copy ws2.Range("A1")
        Application.CutCopyMode = False
    End With
    
    LRow = ws2.Cells.Find("*", , xlFormulas, , 1, 2).Row
    LCol = ws2.Cells.Find("*", , xlFormulas, , 2, 2).Column + 1
    
    a = ws2.Range("D2:E" & LRow)
    ReDim b(1 To UBound(a, 1), 1 To 1)
    
    For i = 1 To UBound(a)
        If a(i, 1) + a(i, 2) = 0 Then b(i, 1) = 1
    Next i
    
    ws2.Cells(2, LCol).Resize(UBound(a)) = b
    i = WorksheetFunction.Sum(Columns(LCol))
    ws2.Range(ws2.Cells(2, 1), ws2.Cells(LRow, LCol)).Sort Key1:=ws2.Cells(2, LCol), order1:=1, Header:=2
    If i > 0 Then ws2.Cells(2, LCol).Resize(i).EntireRow.Delete

    LRow = ws2.Cells.Find("*", , xlFormulas, , 1, 2).Row
    With ws2.Range("A2:A" & LRow)
        .Formula = "=Row()-1"
        .Value = .Value
    End With
    
    Application.ScreenUpdating = True
End Sub