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:

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

<colgroup><col></colgroup><tbody>
</tbody>

 

[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