Macro, delete every other row in a column

[billyheanue]

Hi all,

I have a column that is the result from a pivot table, converted to values. It looks like this:

[TABLE="width: 494"]
<colgroup><col></colgroup><tbody>[TR]
[TD]#2 TRAY FOAM BLK 8X5.75X.75 [/TD]
[/TR]
[TR]
[TD]16200427[/TD]
[/TR]
[TR]
[TD]#20 4-PLY WET MOP N/B COTTON 1.25" HEADBAND CUT END [/TD]
[/TR]
[TR]
[TD]27607114[/TD]
[/TR]
[TR]
[TD]#20 WET MOP 4-PLY RAYON 1.25" N/B H/B CUT END [/TD]
[/TR]
[TR]
[TD]27604080[/TD]
[/TR]
[TR]
[TD]#3 BIOPLUS EARTH 1 RECYCLED CONTAINER 7.75X5.5X2.5 [/TD]
[/TR]
[TR]
[TD]26080042[/TD]
[/TR]
[TR]
[TD]1# FOOD CONTAINER CHIPBOARD 4.375X3.5625X2.5 NAT [/TD]
[/TR]
[TR]
[TD]39541948[/TD]
[/TR]
[TR]
[TD]1/4-SHEET CAKE COMBO 5" ROSEDOME BLACK BASE [/TD]
[/TR]
[TR]
[TD]16203475[/TD]
[/TR]
[TR]
[TD]1/4-SHEET CAKE CONTAINER FOIL [/TD]
[/TR]
[TR]
[TD]31045101[/TD]
[/TR]
[TR]
[TD]1/4-SHT SUNBRITE CAKE BOX HIWALL 14X10X8 [/TD]
[/TR]
[TR]
[TD]54210291[/TD]
[/TR]
[TR]
[TD]10 XLG KLEENGUARD G60 NITRILE CUT RESIST GLOVE/WHT&BLK [/TD]
[/TR]
[TR]
[TD]154074331[/TD]
[/TR]
[TR]
[TD]10" WOODEN SKEWER [/TD]
[/TR]
[TR]
[TD]617008185


... and so on, for nearly 1000 cells. Since I have copied the item numbers into the adjacent column, i need to now delete every other ROW in this column. In total, there are 1083 rows in Column B, and I need to delete every other row, starting with row 2.


Can anyone help?

Thanks![/TD]
[/TR]
</tbody>[/TABLE]

 

[MickG]

Perhaps this:-

[COLOR="Navy"]Sub[/COLOR] MG01Sep57
ActiveSheet.Range("B:B").SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[billyheanue]

I'm sorry Mick,

That didnt work, and I'm not sure what it did exactly

 

[MickG]

It should have deleted all the cells that had only numbers which appeared to be every other row !!!
It worked on the data you supplied !!

 

[MickG]

Try this:-

[COLOR=Navy]Sub[/COLOR] MG01Sep17
[COLOR=Navy]Dim[/COLOR] Lst [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
Lst = Range("B" & Rows.Count).End(xlUp).Row
[COLOR=Navy]For[/COLOR] n = Lst To 1 [COLOR=Navy]Step[/COLOR] -1
    [COLOR=Navy]With[/COLOR] Range("B" & n)
        [COLOR=Navy]If[/COLOR] Application.IsEven(.Row) [COLOR=Navy]Then[/COLOR] .EntireRow.Delete
    [COLOR=Navy]End[/COLOR] With
[COLOR=Navy]Next[/COLOR] n
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

 

[JackDanIce]

Alternatively:

Sub Macro2()

Dim LR As Long
    
    Application.ScreenUpdating = False
    
    With ActiveSheet
        LR = .Range("B" & .rows.Count).End(xlUp).row
        .Range("A:A").Insert
        With .Range("A2:A" & LR)
            .Formula = "=--ISODD(ROW())"
            .Calculate
            .value = .value
            .Replace what:=1, replacement:=vbNullString
            
        End With
        .Range("A:A").Resize(, .Cells.Columns.Count - 1).Sort .Range("A1")
        .Range("A1", .Range("A1").End(xlDown)).EntireRow.Delete
        .Range("A:A").Delete shift:=xlLeft
    End With
    
    Application.ScreenUpdating = True
    
End Sub

 

[My Aswer Is This]

Try this:

Sub Delete_Rows()
Application.ScreenUpdating = False
Dim i As Integer
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "B").End(xlUp).Row
    For i = Lastrow To 2 Step -1
        Rows(2 * i).Delete
    Next
Application.ScreenUpdating = True
End Sub

 

[billyheanue]

Thanks Mick,

That worked great