speeding up loop

Josephoo

New Member
Joined
Dec 7, 2015
Messages
21
Hi everyone

I have a loop that is already working. I was just thinking if there is a way to select all the cells that is zero and deleting it at one go instead of sorting it using a loop 1 by 1 by vba. this have to be done in vba as this is just part of the code in a very long line of codes.

the issue is because there are 3000 cells to evaluate. multiply that with 50 tabs that its cycling. that is a good 150,000 cells to check 1 by 1. the whole process takes me a few hours just to evaluate.

Code:
'delete empty rows
Dim LastRow as long

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For r = LastRow To 1 Step -1
If Cells(r, 1) = 0 Then
Rows(r).Delete
End If
Next r
What this code does is that it will eliminate the zero values rows and consolidate all the known cells for further data manipulation.
would be great if someone can point me in the right direction.

Thanks heaps.
 

Some videos you may like

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,080
Office Version
365
Platform
Windows
This should be quicker. Ive set it to do every sheet in the workbook so be careful!

Code:
Dim sh As Worksheet, lastrow As Long, arr, i As Long, rng As Range

For Each sh In ThisWorkbook.Worksheets
    With sh
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        If lastrow > 1 Then
            arr = .Range("A1:A" & lastrow)
            For i = LBound(arr) To UBound(arr)
                If Not IsEmpty(arr(i, 1)) And arr(i, 1) = 0 Then
                    If Not rng Is Nothing Then
                        Set rng = Union(rng, .Range("A" & i))
                    Else
                        Set rng = .Range("A" & i)
                    End If
                End If
            Next
            If Not rng Is Nothing Then rng.EntireRow.Delete Shift:=xlUp
            Erase arr
            Set rng = Nothing
        End If
    End With
Next
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
45,260
Office Version
365
Platform
Windows
This should be even quicker. This one only acts on the active sheet though. I have assumed the sheet has a heading row. If not, please advise.
If you want it extended to other sheets, is it all sheets in the workbook or just specific sheets?

BTW, if it is to be applied to multiple tabs, do they all have the same number of columns of data? If so, what is the last column in each tab with data?

Code:
Sub Delete_Rows()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) = 0 Then
      b(i, 1) = 1
      k = k + 1
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A2").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub
 

Josephoo

New Member
Joined
Dec 7, 2015
Messages
21
Thanks for the help. Thats very helpful. So basically the workbook have alot of sheets and each sheet have a unique name. there is a master sheet with raw data. all the sheets with unique names has exactly the same format. What i did was that i basically loop thru looking for empty values and then once its done i move on the the next sheet. in VBA i have the following:

sub program()

sheet 1()
Sheet 2()

end sub

So it actually call each sheet and re run the codes over and over again thats all. all the sheets have formula that draws from a master sheet that have raw data. essentially, the master sheet data -> sheets data(sorter) and then i just sort of delete the rows for further data manipulation.

If you have any idea how this can be further speed up, I'm definitely up for learning more!

Thanks man!
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
18,974
Office Version
2013
Platform
Windows
What about using

Code:
Sub MM1()
  With Range("A1", Cells(Rows.Count, "A").End(xlUp))
    .Replace 0, "#N/A", xlWhole, , False, , False, False
    Columns("A").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
  End With
End Sub
 

Josephoo

New Member
Joined
Dec 7, 2015
Messages
21
What about using

Code:
Sub MM1()
  With Range("A1", Cells(Rows.Count, "A").End(xlUp))
    .Replace 0, "#N/A", xlWhole, , False, , False, False
    Columns("A").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
  End With
End Sub
i think it works awesome for values. But My cells are all coded with formula like this. --> "=IF($I3<>$B$1,0,RawData!B2)"
what this does is that it checks col I and try to match with Cell B1. if if the same it will show a value if not zero. maybe i could get it to show NA and then it will just delete accordingly. Let me play around with the col as well as the rest too.

Edit: okay doesnt work with formula. let me think it thru how this should be done.

Peter: Last col is till J all cols have formula build into it. its for specific sheets thou its like 50sheets out of 53 sheets etc. all sheets are identical with same col, forumla and pointing to master raw data. they just have different criteria to only display certain values base on which "company" thats all.

steve and footoo: i need abit of time to try it out and update u guys. Thanks for the help! very interesting solutions.



Thanks people!
 
Last edited:

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
18,974
Office Version
2013
Platform
Windows
Then, untested

Code:
Sub MM1()
  With Range("A1", Cells(Rows.Count, "A").End(xlUp))
    .Replace 0, "#N/A", xlWhole, , False, , False, False
    Columns("A").SpecialCells(xlformulas, xlErrors).EntireRow.Delete
  End With
End Sub
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
45,260
Office Version
365
Platform
Windows
Peter: Last col is till J all cols have formula build into it. its for specific sheets thou its like 50sheets out of 53 sheets etc. all sheets are identical with same col,
OK, give this a try on a copy of your workbook.

Code:
Sub Delete_Rows_v2()
  Dim ws As Worksheet
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long, AppCalc As Long
  
  AppCalc = Application.Calculation
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  nc = 11
  For Each ws In Worksheets
    Select Case ws.Name
      Case "Summary", "Report", "Special Cases" '<- List names of sheets you do NOT want processed
      
      Case Else '< This will do the following code on all other sheets
        k = 0
        With ws
          a = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Value
          ReDim b(1 To UBound(a), 1 To 1)
          For i = 1 To UBound(a)
            If a(i, 1) = 0 Then
              b(i, 1) = 1
              k = k + 1
            End If
          Next i
          If k > 0 Then
            With .Range("A2").Resize(UBound(a), nc)
              .Columns(nc).Value = b
              .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
              .Resize(k).EntireRow.Delete
            End With
          End If
        End With
    End Select
  Next ws
  Application.Calculation = AppCalc
  Application.ScreenUpdating = True
End Sub
 
Last edited:

Josephoo

New Member
Joined
Dec 7, 2015
Messages
21
OK, give this a try on a copy of your workbook.

Code:
Sub Delete_Rows_v2()
  Dim ws As Worksheet
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long, AppCalc As Long
  
  AppCalc = Application.Calculation
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  nc = 11
  For Each ws In Worksheets
    Select Case ws.Name
      Case "Summary", "Report", "Special Cases" '<- List names of sheets you do NOT want processed
      
      Case Else '< This will do the following code on all other sheets
        k = 0
        With ws
          a = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Value
          ReDim b(1 To UBound(a), 1 To 1)
          For i = 1 To UBound(a)
            If a(i, 1) = 0 Then
              b(i, 1) = 1
              k = k + 1
            End If
          Next i
          If k > 0 Then
            With .Range("A2").Resize(UBound(a), nc)
              .Columns(nc).Value = b
              .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
              .Resize(k).EntireRow.Delete
            End With
          End If
        End With
    End Select
  Next ws
  Application.Calculation = AppCalc
  Application.ScreenUpdating = True
End Sub
Thank you sir! I think it works every fast and very well. managed to cut down my timing from 3hrs to 15mins. its very interesting how you implemented it.
 

Watch MrExcel Video

Forum statistics

Threads
1,102,778
Messages
5,488,822
Members
407,658
Latest member
Arias610

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top