Amatya, if I understand correctly you want to improve the part which gets you all the results with 0
s only.
In that case I suggest first copying the sheet and then filtering it like this
Option Explicit
Sub Main()
Application.ScreenUpdating = False
AddWorksheet
FilterResults
Application.ScreenUpdating = True
End Sub
Private Sub AddWorksheet()
Sheets(1).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Working Copy"
End Sub
Private Sub FilterResults()
Dim ws As Worksheet
Dim rng As Range
Dim lastRow As Long
Set ws = ThisWorkbook.Sheets(Sheets.Count)
lastRow = ws.Range("C" & ws.Rows.Count).End(xlUp).Row
Set rng = ws.Range("A1:C" & lastRow)
' filter and delete all but header row
With rng
.AutoFilter Field:=3, Criteria1:="<>0"
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
ws.AutoFilterMode = False
End Sub
In a new workbook I set up a sample data like this (on a Sheet1
)
then ran the code and got a new sheet at the end called "Working Copy"
with the following results
Note: to be fair, I do not know of a faster way to filter results. I created a new sheet instead of copy - pasting ranges which is much slower. Then applied the filter which removed all rows that their 3rd column ( column C ) is not equal to 0.
This run super fast < under 1 second but if you have more data then I understand it may be a bit slower - not much though :)
It took 1 second with 10,000 rows so it's still pretty fast