Slow VBA routine; code appraisal?

TheWennerWoman

Active Member
Joined
Aug 1, 2019
Messages
270
Office Version
  1. 365
Platform
  1. Windows
Hello,

Hope someone can help. I have inherited a routine that takes around three hours to parse approximately 60,000 rows of data.

What it has to do is cut data from an initial dataset (the 60,000 rows) and then paste into either of two other sheets depending on some criteria. I have produced the code below; I appreciate that it's probably not viable for an in-depth look at how it's doing its thing without the underlying dataset but, just as an overview, does anything in the code jump at your expert eyes as a "why do it that way?". Or does the code look about as efficient as it's going to get?

Thank you for your time; the code is:
Code:
lrow = Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row
x = Sheet1.Range("N" & lrow).Value

For y = x To 1 Step -1

lrow = Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row

    Do Until y <> Sheet1.Range("N" & lrow).Value
    Sheet1.Rows(lrow).Copy
    Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Sheet1.Rows(lrow).EntireRow.Delete
    lrow = Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row
    Loop

    lrow1 = Sheet2.Cells(Sheet2.Rows.Count, "B").End(xlUp).Row
    Sheet2.Range("O1:T1").Copy Sheet2.Range("O3:T" & lrow1)
    Sheet2.Range("O3:T" & lrow1).Copy
    Sheet2.Range("O3:T" & lrow1).PasteSpecial xlPasteValues
    z = Application.WorksheetFunction.Sum(Sheet2.Range("Q:Q"))
    If z = 1 Then
        For i = 3 To lrow1
        If Sheet2.Range("Q" & i).Value = 0 Then
        Sheet2.Rows(i).Cut Sheet3.Cells(Sheet3.Rows.Count, "A").End(xlUp).Offset(1, 0)
        Else
        Sheet2.Rows(i).Cut Sheet5.Cells(Sheet5.Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
        Next i
    Else
    Sheet2.Rows("3:" & lrow1).Cut Sheet4.Cells(Sheet4.Rows.Count, "A").End(xlUp).Offset(1, 0)
    End If
        
        
Application.StatusBar = "Progress: " & y & " remaining. " & Format(y / x, "0%")

Next y
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
When you copy or cut and paste, you reproduce formulas, formatting etc. If you are not interested in that but just in the values being transferred to other places then a much faster way would be to load the data into an array in memory and deal with it there then write the results back to the sheet(s) at the end.

To suggest specific code, it would be helpful to see a small set of dummy sample data, the results and an explanation in relation to that data. My signature block below has help with how to post sample data
 
Upvote 0
Solution

Forum statistics

Threads
1,214,590
Messages
6,120,423
Members
448,961
Latest member
nzskater

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top