简体   繁体   中英

VBA Code takes too long to Run

Please see the below VBA Code that I've came up with. Essentially, this is to open another workbook, Unmerge the Rows, Copy the Columns and Paste it into my Active Workbook. However after copy pasting, when the code runs to the CalculationAutomatic line, it takes around 15mins. Is there any other way to make it more efficient? Thank you

Option Explicit

Sub ImportRemarks()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Dim PLPath As String
PLPath = Sheets("Instructions").Range("C16").Text
Dim wbThis As Workbook
Dim wbTarget As Workbook
Set wbThis = ActiveWorkbook
Set wbTarget = Workbooks.Open(PLPath)

wbTarget.Worksheets("Performance List").Select
Rows("1:2").Select
Selection.UnMerge
wbThis.Worksheets("keys").Range("I:I").Value = 
wbTarget.Worksheets("Performance List").Range("F:F").Value
wbThis.Worksheets("keys").Range("J:L").Value = 
wbTarget.Worksheets("Performance List").Range("P:R").Value
wbThis.Activate
Application.CutCopyMode = False
wbTarget.Close savechanges:=False

ActiveWorkbook.Sheets("Instructions").Select
Range("C22").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Maybe something like as follows for starters. Ideally, the optimization steps would go in their own subs. One to switch on optimization at the start and the other to return everything to how it was at the end (or on error).

As requested, this shows you how to remove the .Select parts of your code by using With statements. It also includes a safe exit, in case of error, to switch back on everything you disabled.

Option Explicit
Public Sub ImportRemarks()
    Dim PLPath As String, wbThis As Workbook, wbTarget As Workbook

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

    On Error GoTo Errhand
    Set wbThis = ThisWorkbook
    Set wbTarget = Workbooks.Open(PLPath)
    PLPath = wbThis.Worksheets("Instructions").Range("C16").Text

    wbTarget.Worksheets("Performance List").Rows("1:2").UnMerge

    With wbThis.Worksheets("keys")
        .Range("I:I") = wbTarget.Worksheets("Performance List").Range("F:F")
        .Range("J:L") = wbTarget.Worksheets("Performance List").Range("P:R")
    End With

    wbTarget.Close savechanges:=False

    With wbThis
        .Activate
        ' .Worksheets("Instructions").Range("C22").Activate '<=consider whether this is needed?
    End With

Errhand:
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

More info on optimization here:

https://www.thespreadsheetguru.com/blog/2015/2/25/best-way-to-improve-vba-macro-performance-and-prevent-slow-code-execution

http://www.cpearson.com/excel/optimize.htm

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM