# Thread: speeding up loop Thanks: 0 Likes:  3 Post #5330467 (1)Post #5330473 (1)Post #5330485 (1)

1. ## speeding up loop

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.  Reply With Quote

2. ## Re: speeding up loop  Reply With Quote

3. ## Re: speeding up loop

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```  Reply With Quote

4. ## Re: speeding up loop

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```  Reply With Quote

5. ## Re: speeding up loop

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!  Reply With Quote

6. ## Re: speeding up loop

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```  Reply With Quote

7. ## Re: speeding up loop Originally Posted by Michael M 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!  Reply With Quote

8. ## Re: speeding up loop

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```  Reply With Quote

9. ## Re: speeding up loop Originally Posted by Josephoo 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```  Reply With Quote

10. ## Re: speeding up loop Originally Posted by Peter_SSs 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.  Reply With Quote

## User Tag List

#### Tags for this Thread

cells, code, evaluate, loop, vba #### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•