We help IT Professionals succeed at work.
Troubleshooting Question

How to make Code more efficient

108 Views
Last Modified: 2020-08-23
How is the best way to optimize the code below? It'll work but takes a very long time in doing so.

Sub CopyPasteData()             '
    Dim Firstrow As Long, LastRow As Long
    Dim iRow As Long
    Dim Asht As Worksheet
    Dim arr() As Variant
 
appOFF
Set Asht = ThisWorkbook.ActiveSheet
    With Asht
        Firstrow = 2
        LastRow = Range("AB" & Rows.Count).End(xlUp).Row
            arr = Range("AB1:AB" & LastRow)
            For iRow = LastRow To Firstrow Step -1
                If arr(iRow, 1) Like "Duplicate" Then
                    Range("T" & iRow & ":X" & iRow).Copy
                    Range("L" & (iRow - 1) & ":P" & (iRow - 1)).PasteSpecial xlPasteValues
                    Rows(iRow).Delete
               End If
            Next
    End With
appON
End Sub
 
Comment
Watch Question

KimputerIT Manager
CERTIFIED EXPERT

Commented:
No, you don't have lines that can be functionally compacted, as you're not doing anything over the top. You're just looping throught the rows, and there probably are quite a few. Use Task Manager when using this, and if the CPU (or one core) is at 100% the whole time, you can only improve it by running it on a more powerful computer.
NorieAnalyst Assistant
CERTIFIED EXPERT

Commented:
You might be able to speed things up by using arrays.

Could you attach a workbook with sample data?
Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:
Try this approach, typically avoiding "copy" and rather assigning values when possible is much faster.

Sub CopyPasteData()             '
    Dim Firstrow As Long, LastRow As Long
    Dim iRow As Long
    Dim Asht As Worksheet
    Dim arr() As Variant
 
    appOFF
    Set Asht = ThisWorkbook.ActiveSheet
        With Asht
            Firstrow = 2
            LastRow = Range("AB" & Rows.Count).End(xlUp).Row
                arr = Range("AB1:AB" & LastRow)
                For iRow = LastRow To Firstrow Step -1
                    If arr(iRow, 1) Like "Duplicate" Then
                        'Range("T" & iRow & ":X" & iRow).Copy
                        'Range("L" & (iRow - 1) & ":P" & (iRow - 1)).PasteSpecial xlPasteValues
                        Range("L" & (iRow - 1) & ":P" & (iRow - 1)).Value = Range("T" & iRow & ":X" & iRow).Value
                        Rows(iRow).Delete
                   End If
                Next
        End With
    appON
End Sub

Open in new window


»bp

Author

Commented:
Attached is just a sample...but I'll try Bill's solution right now.
EE Sample.xlsx
ste5anSenior Developer
CERTIFIED EXPERT
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION
Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:
Good point on doing the deletions all at once as a range, I often use that when a large number of rows will need to be deleted, can save a good bit of time.

»bp
NorieAnalyst Assistant
CERTIFIED EXPERT

Commented:
Bill and ste5an's suggestions should speed things up but I'll post this anyway.

Using arrays usually speeds things up but it does have disadvantages, for example you'll lose any formulas or formatting.
Sub Test()
Dim Asht As Worksheet
Dim arrIn() As Variant
Dim arrOut() As Variant
Dim LastRow As Long
Dim cnt As Long
Dim idxCol As Long
Dim idxRow As Long

    Set Asht = ThisWorkbook.ActiveSheet
    
    With Asht
        LastRow = .Range("AB" & Rows.Count).End(xlUp).Row
        arrIn = Range("A1:AB" & LastRow)
    End With
    
    ReDim arrOut(1 To UBound(arrIn, 2), 1 To UBound(arrIn, 1))
    
    For idxRow = LBound(arrIn, 1) To UBound(arrIn, 1)
        
        If arrIn(idxRow, UBound(arrIn, 2)) = "Duplicate" Then
            For idxCol = 12 To 16
                arrOut(idxCol, cnt - 1) = arrIn(idxRow, idxCol + 4)
            Next idxCol
        Else
            cnt = cnt + 1
            
            For idxCol = LBound(arrIn, 2) To UBound(arrIn, 2)
                arrOut(idxCol, cnt) = arrIn(idxRow, idxCol)
            Next idxCol
        End If
        
    Next idxRow
            
    ReDim Preserve arrOut(1 To UBound(arrIn, 2), 1 To cnt)
        
    With Sheets("Sheet1")
        .Range("A1").Resize(UBound(arrOut, 2), UBound(arrOut, 1)).Value = Application.Transpose(arrOut)
    End With
    
End Sub

Open in new window

Author

Commented:
ste5an - I ran your code, but it didn't delete the rows
Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Cook09, in your code you call a sub called appOFF. If that sub includes an Application.EnableEvents = False with the intention of having it off when the rest of the code in CopyPasteData executes, it won't be since Application.EnableEvents is set to True by Excel when you exit that sub (or any similar sub). The solution is of course to put the contents of your appOFF sub at the top of the CopyPasteData sub which will speed it up. Try the following if you want to see if I'm correct or not.

Sub appOFF()
Application.EnableEvents = False
End Sub

Sub test()
appoff
MsgBox Application.ScreenUpdating
End Sub

Open in new window

Author

Commented:
Yes Martin...the intention was to have a function do it all. Let me try putting all those directly into the code.  Does this apply to all included..
    Application.ScreenUpdating = False
  Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:
Martin, are you sure, I typically use a function like shown below for this, and in the test shown there it seems to be working as I expect. Or maybe I misunderstood you.

Sub Martin()
    Debug.Print "ScreenUpdating = " & Application.ScreenUpdating
    Debug.Print "EnableEvents = " & Application.EnableEvents
    Debug.Print "Calculation = " & Application.Calculation
    SetUpdating False
    Debug.Print "ScreenUpdating = " & Application.ScreenUpdating
    Debug.Print "EnableEvents = " & Application.EnableEvents
    Debug.Print "Calculation = " & Application.Calculation
    SetUpdating True
    Debug.Print "ScreenUpdating = " & Application.ScreenUpdating
    Debug.Print "EnableEvents = " & Application.EnableEvents
    Debug.Print "Calculation = " & Application.Calculation
End Sub

Private Sub SetUpdating(Mode As Boolean)
    With Application
        .ScreenUpdating = Mode
        .EnableEvents = Mode
        If Mode = False Then
            .Calculation = xlCalculationManual
        Else
            .Calculation = xlCalculationAutomatic
        End If
    End With
End Sub

Open in new window


ScreenUpdating = True
EnableEvents = True
Calculation = -4105
ScreenUpdating = False
EnableEvents = False
Calculation = -4135
ScreenUpdating = True
EnableEvents = True
Calculation = -4105

Open in new window


»bp

Author

Commented:
I tried the test and with included all the ones I use, they seem to be "False, or -4135"

Author

Commented:
ste5an...Would you know why your code would not delete the rows with duplicate in AB?
Norrie, How would you write for rows to be deleted in your code?
ste5anSenior Developer
CERTIFIED EXPERT

Commented:
Missed a Set..

            If RangeToDelete Is Nothing Then
              Set RangeToDelete = Rows(iRow)
            Else
              Set RangeToDelete = Application.Union(RangeToDelete, Rows(iRow))
            End If

Open in new window

Test your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION
Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Martin, are you sure
Please see what hovering over the ScreenUpdating line the shows
2020-08-21_12-23-30.png

Author

Commented:
Ok...let me try both
Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:
Martin,

What version of Excel are you running?


»bp
Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:
Martin,

Can you post the results of my test that I ran in https://www.experts-exchange.com/questions/29192308/How-to-make-Code-more-efficient.html#a43144269, with the Debug displays in it.  Curious how the other settings behaved for you...


»bp

Author

Commented:
Bill...Excel 2016 -- Yes it does make a difference with me using an array. For 10K with 1400 duplicate cells (700 removed), yours was .94 seconds and my code was 7.3 seconds.

Author

Commented:
Bill.....Why would it make that much difference?    Well..one thing, I was still my old code with the two commands for copy paste.

Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:
Copy Paste I believe will be your biggest gain, which I think you are saying got you from 7.3 to .94 seconds, yes?

If so then I think you are done, unless you want to go for saving fractions of that second...  🙂


»bp

Author

Commented:
No, I'm good.  It seems Bill, both yours, and ste5an, were within about .1 of each other and mine a distant 3rd.  Thank You.
NorieAnalyst Assistant
CERTIFIED EXPERT

Commented:
Cook09

In the code I posted rather than deleting rows it doesn't copy the rows marked as 'Duplicate' to the new array.

I've checked and the result of my code is the same as that achieved by your original code, for the supplied data anyway.
Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:
Great, glad that helped, you got some good suggestions here from the experts.

»bp
byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
I realize that the question has been well answered, but I am bothered by the use of a With block that doesn't start any reference with a dot. It doesn't make any difference in this particular instance because the With block references the active sheet. But if you make the effort to use a With block, you should avoid using unqualified references.

Using fully qualified references and With blocks are good coding habits. First, even if you call a sub while another worksheet is active, your code still works with the correct objects. Second, if you can shorten the qualification chain (such as by specifying the workbook and/or worksheet in the With block), the code will run faster. Third, if you copy the code and use it in another sub, there is less to change.

For example, I would rewrite Bill Prew's code as shown below. Note the use of .Range and .Rows in lines 11, 13, 14, and 15.
Sub CopyPasteData()             '
    Dim Firstrow As Long, LastRow As Long
    Dim iRow As Long
    Dim Asht As Worksheet
    Dim arr() As Variant
 
    appOFF
    Set Asht = ThisWorkbook.ActiveSheet
        With Asht
            Firstrow = 2
            LastRow = .Range("AB" & .Rows.Count).End(xlUp).Row
                For iRow = LastRow To Firstrow Step -1
                    If .Range("AB" & iRow).Value Like "Duplicate" Then
                        .Range("L" & (iRow - 1) & ":P" & (iRow - 1)).Value = .Range("T" & iRow & ":X" & iRow).Value
                        .Rows(iRow).Delete
                   End If
                Next
        End With
    appON
End Sub
Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:
Good catch byundy, I was so focused on the specific problem the author mentioned, I didn't carefully study the existing code.  Absolutely agree on always qualifying things like Range with a parent object, having been burned enough times by floating references that later break.


»bp

Author

Commented:
Thanks, I will make the changes. What I did notice is a significant increase in time from 10-15k to 60k. Even tried to split the code into two Subs. Not sure what is occurring, but I’ll make these changes and see how it runs. I did notice, at times, a ‘Printer Error’ in Task Manager. Ended the task, but still had to X out and attempt again. It seems the sweet spot is 15-20k.
Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Humor a stubborn old man please and put the following right after line 7 (appOFF) and let me know if it makes any difference in speed,

With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .Calculation=xlCalculationManual
End With

Open in new window

Author

Commented:
Martin..yes I did put what you had earlier suggested. Not sure it improved things a lot...but not definitive about it. Will run some more tomorrow.
Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
If you are interested in knowing definitively which is faster then please see my how to time code article and run it a thousand or more times against a 100-row sample of your data, with and without my added code.

Gain unlimited access to on-demand training courses with an Experts Exchange subscription.

Get Access
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Empower Your Career
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.