Deleting range of rows in subroutine loop

**driffert** · 06-09-2010, 09:32 AM

I have developed a subroutine to delete a single row if a particular cell content is zero and it works fine. I now need to adapt that subroutine so that if a particular cell is zero the current row + the next row is deleted and then it moves on to the next row to test again. Can someone tell me how to change the below subroutine to accomplish that? Thanks.

Denny Riffert
Evansville, IN

Range("D1").Select
Set CurrentCell = Range("D1")

For Count = 1 To 500
Set nextCell = CurrentCell.Offset(2, 0)
If CurrentCell.Value = 0 Then
CurrentCell.EntireRow.Delete
End If
Set CurrentCell = nextCell
Next Count

**Bob Phillips** · 06-09-2010, 09:44 AM

Please Login or Register  to view this content.

**driffert** · 06-09-2010, 09:50 AM

Thanks Bob but I'm new to VBA and need some clarification. What exactly occurs when your code is used? Thanks

**driffert** · 06-09-2010, 10:12 AM

Bob,

I'm confused by the "i" in your code. What exactly does it signify? Thanks

**Bob Phillips** · 06-09-2010, 10:12 AM

It deletes two rows when the condition is met, as requested.

**driffert** · 06-09-2010, 11:07 AM

Bob,

When I use your code, I receive a compile error "invalid next control variable reference" and it highlights "Next i". What am I doing wrong? Thanks.

**Bob Phillips** · 06-09-2010, 01:03 PM

It has to be in a procedure, a Sub or a Function. Wasn't your original code in such a procedure?

**driffert** · 06-09-2010, 01:49 PM

Bob,

I figured it out. All my code is listed below. I had to change "For Count = 500 To 1 Step -1" in your code to "For i = 500 To 1 Step -1". Thanks for all your help on this.

Code

Sub CreateVoucher()
'
' CreateVoucher Macro
' Create A/P voucher
'
' Keyboard Shortcut: Ctrl+e
'
Name = ThisWorkbook.Worksheets("Variables").Range("filename")

Application.Goto Reference:="voucher"
Selection.Copy
Workbooks.Add
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D1").Select

For i = 500 To 1 Step -1
If Cells(i, "D").Value = 0 Then
Rows(i).Resize(2).Delete
End If
Next i

ActiveWorkbook.SaveAs Filename:=Name, FileFormat:=xlExcel8, CreateBackup:=False
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Sheets("Vectren").Select
Range("A1").Select
End Sub