Please help!

D

Denise

I want to set up a condition where a row is deleted ONLY if BOTH cells equal
zero. Currently the macro below delete the row when the first cell = zero.
Thus when there is something in the second cell and the first cell is zero
the row is deleted.

The code is below if someone could assist I would be greatful.

'
Sheets("Report").Select
Cells.Select
Selection.Copy
Sheets.Add
Cells.Select
ActiveSheet.Paste
Range("D11:H120").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Dim DeleteFlag As Boolean
DeleteFlag = True
While DeleteFlag = True
DeleteFlag = False
Range("A11:H120").Select
For Each rw In Selection.Rows
If rw.Cells(1, 4).Value = 0 And rw.Cells(1, 9) = 0 And
IsNumeric(rw.Cells(1, 1).Value) And Not IsEmpty(rw.Cells(1, 1)) Then
rw.Delete
DeleteFlag = True
'rw.Cells(1, 10).Value = "Zero"
End If
Next rw
Wend
Application.CutCopyMode = False
Range("D16").Select
ActiveWindow.Zoom = 85
Range("A3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveSheet.Name = Right(Trim(Selection.Value), 5)
Application.CutCopyMode = False
Range("A3").Select
Sheets("Macro1").Select
Range("C2").Select
Selection.Delete Shift:=xlUp
Sheets("Report").Select
Range("A3").Select
ActiveCell.FormulaR1C1 = "=Macro1!R[-1]C[2]"
Range("A3").Select
Sheets("Data").Select
Range("D4:E88").Select
Selection.ClearContents
End Sub
 
B

Bob Phillips

You should delete bottom up. Try this

Dim DeleteFlag As Boolean
Dim rw As Long

Sheets("Report").Copy after:=Sheets(Sheets.Count)
Range("D11:H120").Value = Range("D11:H120")
DeleteFlag = True
For rw = 120 To 11 Step -1
If Cells(rw, "D").Value = 0 And Cells(rw, "I") = 0 And _
IsNumeric(Cells(rw, "A").Value) And Not IsEmpty(Cells(rw, "A"))
Then
Rows(rw).Delete
End If
Next rw
ActiveWindow.Zoom = 85
Range("A3").Value = Range("A3").Value
ActiveSheet.Name = Right(Trim(Selection.Value), 5)
Sheets("Macro1").Range("C2").Delete Shift:=xlUp
Sheets("Report").Range("A3").FormulaR1C1 = "=Macro1!R[-1]C[2]"
Sheets("Data").Range("D4:E88").ClearContents


--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)
 
D

Denise

Bob,

Thank you for the ocde, however I get a syntax error in line 8 of your code
when I apply it to mine. Do you have any Ideas?

regards,
Denise

Bob Phillips said:
You should delete bottom up. Try this

Dim DeleteFlag As Boolean
Dim rw As Long

Sheets("Report").Copy after:=Sheets(Sheets.Count)
Range("D11:H120").Value = Range("D11:H120")
DeleteFlag = True
For rw = 120 To 11 Step -1
If Cells(rw, "D").Value = 0 And Cells(rw, "I") = 0 And _
IsNumeric(Cells(rw, "A").Value) And Not IsEmpty(Cells(rw, "A"))
Then
Rows(rw).Delete
End If
Next rw
ActiveWindow.Zoom = 85
Range("A3").Value = Range("A3").Value
ActiveSheet.Name = Right(Trim(Selection.Value), 5)
Sheets("Macro1").Range("C2").Delete Shift:=xlUp
Sheets("Report").Range("A3").FormulaR1C1 = "=Macro1!R[-1]C[2]"
Sheets("Data").Range("D4:E88").ClearContents


--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

Denise said:
I want to set up a condition where a row is deleted ONLY if BOTH cells
equal
zero. Currently the macro below delete the row when the first cell = zero.
Thus when there is something in the second cell and the first cell is zero
the row is deleted.

The code is below if someone could assist I would be greatful.

'
Sheets("Report").Select
Cells.Select
Selection.Copy
Sheets.Add
Cells.Select
ActiveSheet.Paste
Range("D11:H120").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
Dim DeleteFlag As Boolean
DeleteFlag = True
While DeleteFlag = True
DeleteFlag = False
Range("A11:H120").Select
For Each rw In Selection.Rows
If rw.Cells(1, 4).Value = 0 And rw.Cells(1, 9) = 0 And
IsNumeric(rw.Cells(1, 1).Value) And Not IsEmpty(rw.Cells(1, 1)) Then
rw.Delete
DeleteFlag = True
'rw.Cells(1, 10).Value = "Zero"
End If
Next rw
Wend
Application.CutCopyMode = False
Range("D16").Select
ActiveWindow.Zoom = 85
Range("A3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
ActiveSheet.Name = Right(Trim(Selection.Value), 5)
Application.CutCopyMode = False
Range("A3").Select
Sheets("Macro1").Select
Range("C2").Select
Selection.Delete Shift:=xlUp
Sheets("Report").Select
Range("A3").Select
ActiveCell.FormulaR1C1 = "=Macro1!R[-1]C[2]"
Range("A3").Select
Sheets("Data").Select
Range("D4:E88").Select
Selection.ClearContents
End Sub
Click to expand...
Click to expand...
 
B

Bob Phillips

That is NG wrap-around. The 'Then' that is on a line of its own should be on
the previous line.

This code replaces yours.

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

Denise said:
Bob,

Thank you for the ocde, however I get a syntax error in line 8 of your
code
when I apply it to mine. Do you have any Ideas?

regards,
Denise

Bob Phillips said:
You should delete bottom up. Try this

Dim DeleteFlag As Boolean
Dim rw As Long

Sheets("Report").Copy after:=Sheets(Sheets.Count)
Range("D11:H120").Value = Range("D11:H120")
DeleteFlag = True
For rw = 120 To 11 Step -1
If Cells(rw, "D").Value = 0 And Cells(rw, "I") = 0 And _
IsNumeric(Cells(rw, "A").Value) And Not IsEmpty(Cells(rw,
"A"))
Then
Rows(rw).Delete
End If
Next rw
ActiveWindow.Zoom = 85
Range("A3").Value = Range("A3").Value
ActiveSheet.Name = Right(Trim(Selection.Value), 5)
Sheets("Macro1").Range("C2").Delete Shift:=xlUp
Sheets("Report").Range("A3").FormulaR1C1 = "=Macro1!R[-1]C[2]"
Sheets("Data").Range("D4:E88").ClearContents


--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)

Denise said:
I want to set up a condition where a row is deleted ONLY if BOTH cells
equal
zero. Currently the macro below delete the row when the first cell =
zero.
Thus when there is something in the second cell and the first cell is
zero
the row is deleted.

The code is below if someone could assist I would be greatful.

'
Sheets("Report").Select
Cells.Select
Selection.Copy
Sheets.Add
Cells.Select
ActiveSheet.Paste
Range("D11:H120").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:=
_
False, Transpose:=False
Dim DeleteFlag As Boolean
DeleteFlag = True
While DeleteFlag = True
DeleteFlag = False
Range("A11:H120").Select
For Each rw In Selection.Rows
If rw.Cells(1, 4).Value = 0 And rw.Cells(1, 9) = 0 And
IsNumeric(rw.Cells(1, 1).Value) And Not IsEmpty(rw.Cells(1, 1)) Then
rw.Delete
DeleteFlag = True
'rw.Cells(1, 10).Value = "Zero"
End If
Next rw
Wend
Application.CutCopyMode = False
Range("D16").Select
ActiveWindow.Zoom = 85
Range("A3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:=
_
False, Transpose:=False
ActiveSheet.Name = Right(Trim(Selection.Value), 5)
Application.CutCopyMode = False
Range("A3").Select
Sheets("Macro1").Select
Range("C2").Select
Selection.Delete Shift:=xlUp
Sheets("Report").Select
Range("A3").Select
ActiveCell.FormulaR1C1 = "=Macro1!R[-1]C[2]"
Range("A3").Select
Sheets("Data").Select
Range("D4:E88").Select
Selection.ClearContents
End Sub
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

conso macro 0
Run-time error 1004 paste method of worksheet class failed 3
= Today()+1 into Sheet1, Sheet2, and Sheet3 2
Copy Paste Macro not Pasting Values when Blank 3
Run macro from active workbook whose name keeps changing 20
Help again!!! 1
Error using offset 1
Tannspose and cycle 4

Top