# speeding up loop

#### Josephoo

##### New Member
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.

### Excel Facts

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

#### footoo

##### Well-known Member
• Josephoo

#### steve the fish

##### Well-known Member
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``````

• Josephoo

#### Peter_SSs

##### MrExcel MVP, Moderator
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
.Resize(k).EntireRow.Delete
End With
Application.ScreenUpdating = True
End If
End Sub``````

• Josephoo

#### Josephoo

##### New Member
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

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

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
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
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
.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
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
.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.

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...