As I have explained many times on this forum, one of the main reaons that Vba is slow is the time taken to access the worksheet from VBa is often the bottleneck.
To speed up vba the easiest way is to minimise the number of accesses to the worksheet. What is interesting is that the time taken to access a single cell on the worksheet in vba is almost identical as the time taken to access a large range if it is done in one action. So instead of writiing a loop which loops down a range deleting one row at a time which will take along time if you have got 50000 rows it is much quicker to load the 50000 lines into a variant array ( one worksheet access), delete all the data ( one worksheet access) then copy the lines to two different array depending on whether they are going back to resuults or main and then write the two arrays back ( two more worksheet accesses), total number of worksheet accesses 4, instead of the multiple accesses in the code above.
I have a simple rule for fast VBA: NEVER ACCESS THE WORKSHEET IN A LOOP.
Note if you have set range variable to a worksheet range you are still accessing the worksheet so it will be slow.
This code does this and it will run superfast regardless on the number of lines of code.
Sub superfast()
dim inarr as variant
dim mainarr as variant
dim resultarr as variant
Sheets("result").UsedRange.EntireRow.Delete
With Worksheets("main")
lastrow = .Cells(Rows.Count, "D").End(xlUp).Row
' load data into a variant array
inarr = Range(.Cells(1, 1), .Cells(lastrow, 8))
' clear the worksheet
Range(.Cells(2, 1), Cells(lastrow, 8)) = ""
'load the two output arrays with headers and blank cells
mainarr = Range(.Cells(1, 1), .Cells(lastrow, 8))
resultarr = Range(.Cells(1, 1), .Cells(lastrow, 8))
mn = 3
rs = 3
' loop round all the data
For i = 3 To lastrow
' test if col D is blank
If inarr(i, 4) = "" Then
' copy to Results
For k = 1 To 8
resultarr(rs, k) = inarr(i, k)
Next k
rs = rs + 1
Else
'copy to main
For k = 1 To 8
mainarr(mn, k) = inarr(i, k)
Next k
mn = mn + 1
End If
Next i
' write the main sheet out
Range(.Cells(1, 1), .Cells(lastrow, 8)) = mainarr
End With
With Worksheets("result")
' wite the results sheet out
Range(.Cells(1, 1), .Cells(lastrow, 8)) = resultarr
End With
End Sub
Note: you will probably have to declare a whole load variables becasue I never use option explicit. I grew up before it existed and I find it a pain in the neck
all my varinable should be self explanatory