Delete Every 2nd & 3rd Row

[Mickey]

Hi,
I need to find a quicker way to delete every 2nd & 3rd row of three rows.
e.g. Delete Row 2 & 3, then 3 & 4, then 4 & 6. Can anyone help?, The below
does it but requires me to add a statement for each set of three rows, as
the data can vary from 3 rows to several thousand, I need something more
automatic.

Sub Macro1()
'
'
Rows("2:3").Select
Selection.Delete Shift:=xlUp
Rows("3:4").Select
Selection.Delete Shift:=xlUp
Rows("4:5").Select
Selection.Delete Shift:=xlUp
End Sub

 

[Don Guillett]

try
Sub deletetworows()
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -3
Cells(i - 1, 1).Resize(2).EntireRow.Delete 'Select
Next i
End Sub

1
4
7
10

 

[Tom Ogilvy]

Sub Macro2()
Range("B1").Select
Do While ActiveCell.Offset(1, 0) <> ""
ActiveCell.Offset(1, 0).Resize(2).EntireRow.Delete
ActiveCell.Offset(1, 0).Select
Loop
End Sub

change B1 to the first cell in a column that will contain data. (or to the
first cell where you want to start the process in a column that contains
data - it doesn't have to start in any particular row)

 

[Guest]

The sub looks in column A for the last row with values
Then it use column IV temporary - i ges u dont use that one
try on a copy of ur sheet first, just in case

Sub Speed()
r = Cells(65536, 1).End(xlUp).Row ' if not col.A change '1' to right one
For t = 4 To r Step 3
Cells(t, 256) = 1
Next
Range("IV2:IV" & r).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("IV2:IV" & r) = ""
End Sub



"Mickey" skrev:

 

[Mickey]

Thank you Don, Tom and excelent. These are just what I need, I'm going to
work my way through them and try to understand how they are working.

Thanks again,
Mickey

 

[Robert McCurdy]

The sequel?

Sub SpeedII()
With ActiveSheet.UsedRange
With .Columns(.Columns.Count + .Column + 1)
.Formula = "=1/n(1+mod(row(a1),3)=2)"
.SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
.Value = ""
End With
End With
End Sub


Regards
Robert McCurdy

The sub looks in column A for the last row with values
Then it use column IV temporary - i ges u dont use that one
try on a copy of ur sheet first, just in case

Sub Speed()
r = Cells(65536, 1).End(xlUp).Row ' if not col.A change '1' to right one
For t = 4 To r Step 3
Cells(t, 256) = 1
Next
Range("IV2:IV" & r).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("IV2:IV" & r) = ""
End Sub



"Mickey" skrev:

 

[Mickey]

Thanks Robert,

Mickey