Shortening my script

stooven

New Member
Joined
Oct 12, 2006
Messages
15
Hello!
With help from Norie and your archives, I was able to produce a working script for automating a task in my office. My only issue is that my script takes a long time to run. (I run it on very large spreadsheets) I was hoping someone could help me find a way to shorten my runtime while keeping exactly the same output. Any help would be greatly appreciated.

This is my script:

Code:
Sub Zeroremover()
Dim cell As Range
Dim aRange As Range
Set aRange = Range(Range("I1"), Range("I65536").End(xlUp))

    For Each cell In aRange
        If cell.Value <> "0" Then
            cell.EntireRow.Hidden = True
        End If
    Next cell
    
    aRange.SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Sheet2").Range("A1")
    aRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete
    aRange.Cells.EntireRow.Hidden = False
    
End Sub

Thanks!
Steve
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.

Jon von der Heyden

MrExcel MVP, Moderator
Joined
Apr 6, 2004
Messages
10,808
Office Version
  1. 365
Platform
  1. Windows
I had the same problem not so long ago - the reason it takes so long is because you're using a loop. Seems to me as though perhaps using auto-filter is a viable solution.

See attached post where I had a similar event and notice how Richard's suggested method using auto-filter is applied. You should be able to adapt to your needs.

http://www.mrexcel.com/board2/viewtopic.php?t=192430

Regards,
Jon
 

stooven

New Member
Joined
Oct 12, 2006
Messages
15
Thank you very much, Jon. Seems a little tricky yet only because this is my second day ever using VBA but I shall try and hopefully learn something. =-)

Steve
 

stooven

New Member
Joined
Oct 12, 2006
Messages
15
Thank you SO much Jon and Norie! I cut the loop out and changed my above code to the following:

Code:
Sub Zerobuster()
Dim cell As Range
Dim aRange As Range
Set aRange = Range(Range("I2"), Range("I65536").End(xlUp))

    Selection.AutoFilter
    Selection.AutoFilter Field:=9, Criteria1:="0"
    
    aRange.SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Sheet2").Range("A1")
    aRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete
    aRange.Cells.EntireRow.Hidden = False
    
Dim bRange As Range
Set bRange = Range(Range("D2"), Range("D65536").End(xlUp))

    Selection.AutoFilter
    Selection.AutoFilter Field:=4, Criteria1:="0"
    
    bRange.SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Sheet3").Range("A1")
    bRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete
    bRange.Cells.EntireRow.Hidden = False

Selection.AutoFilter
    
End Sub

It works perfectly and cut my processing time from several minutes to a fraction of a second!

Thanks again,
Steve
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,300
Office Version
  1. 365
Platform
  1. Windows
Steve

You could probably cut the time down further by not using Selection.

In fact you might be able to use Advanced Filter instead of AutoFilter, but I'm not sure about that because I can't remember fully what the original thread was about.:eek:

Could you post a link to it?

Looking at the code it appears this is what you are doing.

1 Copying every row that has a zero in column I to sheet 2.

2 Copying every row that has a zero in column D to sheet 3.

Is that about right?
 

Forum statistics

Threads
1,137,204
Messages
5,680,166
Members
419,887
Latest member
Vasokir

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top