TheWennerWoman
Active Member
- Joined
- Aug 1, 2019
- Messages
- 303
- Office Version
- 365
- Platform
- Windows
Hello,
I have inherited a file that needs to be run overnight as it ties up Excel and takes hours. The relevant piece of code is below, is there anything obvious that leaps out at you gurus as being bad practice and that can be replaced.......anything that gives a speed improvement would be really appreciated.
Thanks in advance.
I have inherited a file that needs to be run overnight as it ties up Excel and takes hours. The relevant piece of code is below, is there anything obvious that leaps out at you gurus as being bad practice and that can be replaced.......anything that gives a speed improvement would be really appreciated.
VBA 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
Thanks in advance.