asked on

Excel 2010 Fast Delete

I am looking for some VBA code that will quickly delete all rows where there is a 0 in column B.

I am using the following code but as there are over 150k rows in the file each day it takes a while to complete.

Dim LR As Long, i As Long
LR = Range("B" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
If Not Range("B" & i).Value <> 0 Then Rows(i).Delete
Next i

Thanks In advance.

plummet

How about something along these lines:

Columns("B:B").Select
Selection.AutoFilter Field:=1, Criteria1:= 0
Cells.Select
Selection.Delete Shift:=xlUp

I think that should be much quicker.

Regards
John

Jagwarman

ASKER

I need it as part of a Macro because there are a dozen or so other things going on and I don't want the user to stop half way through the macro to do that manually and then go back into the macro to complete the process.

Jagwarman

ASKER

plummet, I mis read what you said, however, your solution takes out the header row.

plummet

OK, didn't know you had one. Try this:

Dim rng As Range

Columns("B:B").Select
Selection.AutoFilter Field:=1, Criteria1:= 0
With UsedRange
Set rng = Range(.Cells(2, 1), .Cells(1, 1).Offset(.Rows.Count - 1, .Columns.Count - 1))
End With
rng.Select
Selection.Delete shift:=xlUp

MSmax

Hey try below and let me know if it works for you

Sub Delete_Rows()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim LR As Long, i As Long
    
    
    Set wb = ThisWorkbook
    'Change the "Sheet1" to anything you like
    Set ws = wb.Worksheets("Sheet1")
    
    'Get the last used row
    LR = ws.Range("B" & Rows.Count).End(xlUp).Row
    
    'Turn off the filter
    ws.AutoFilterMode = False
    
    'Change it to select all the columns you need
    Set rng = ws.Range("A1:B" & LR)
    
    rng.AutoFilter Field:=2, Criteria1:="0"
    
    'if no row meting criteria go to Exit
    On Error GoTo Exit1
    Set rng = ws.Range("A2:B" & LR).SpecialCells(xlCellTypeVisible)

    rng.EntireRow.Delete
    
Exit1:
    'Reset errors
    On Error GoTo 0
    'Turn off the filter
    ws.AutoFilterMode = False

End Sub

Open in new window

Jagwarman

ASKER

MSMax I get a VB error

Run-time error

The command could not be completed by using the range specified. Select a single cell within the range and try the command again.

plummet

Did you try my solution?

MSmax

Can you please post your excel file so I can see why its not working?

Regards,

MSMax

Jagwarman

ASKER

Plummet

it did and got this error "Object Required" on this row
Set rng = Range(.Cells(2, 1), .Cells(1, 1).Offset(.Rows.Count - 1, .Columns.Count - 1))

Jagwarman

ASKER

MS MAX

I can't post my file will build a dummy file and post it later

plummet

Oh dear, it should work fine.

Did you definitely have the line:

With Usedrange

above the line that errors? Make sure it's exactly as my example.

Jagwarman

ASKER

plummet, yes I copy pasted your code

plummet

Sorry to hear that - I'll check it again and get back to you

ASKER CERTIFIED SOLUTION

plummet

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Jagwarman

ASKER

That is very odd, I guess it must have been me.

Thanks

plummet

No, you were right when I tried my original code it failed just as you said. I am on a different PC today, so who knows.

Anyway I'm glad it helped!

Jagwarman

ASKER

plummet, would this work for blank rows and if so how would I change it?

thanks

plummet

I don't think so, it's basically doing a filter in code and I don't think you can filter for blank rows. However it can be done in code a different way.

Your username implies you're either a Jaguar fan or work for them, just wondering because I work for Jaguar Land Rover :-)

Jagwarman

ASKER

I drive an X type but have had XJ's and Sovereigns in the past. I have a funny noise coming from rear near side at the moment so need to get it in to get sorted soon.

I will post a new request later maybe

thanks

plummet

I'll work out some VBA and will try to keep an eye out for the new request