Copying worksheets macro results in a slow workbook

[nwille7400]

Hello,
I set up a macro in a workbook (let's call this prog workbook) to open every workbook (let's call these spec workbooks) in a folder (about 2600 of them), copy information from the spec workbooks into yet another workbook (which is a revised template, call it temp workbook). After that is done the prog workbook macro runs a macro in the temp workbook to refresh with the new data. After that the spec workbook is closed and deleted from the folder and the temp workbook is saved as the spec workbook filename in the original spec workbook folder. This all seemed to work well, however, when I open up the new spec workbook (temp workbook saved with spec info and spec file name) it runs very slow. Clicking between tabs in this work book and running any macros go very slow.

Could anyone help me figure out what could be causing this? If I do this operation manually it doesn't result in a slow functioning workbook. See code below. Let me know if you have any questions. Thanks!!!

Sub Button1_Click()
'this sets your template workbook/worksheet
Dim shp As Shape
     
    'start code to update insp report
    Dim copyWB As Workbook
    Set copyWB = ThisWorkbook
    'open insp report to copy from
    file_name = "new inspection report_Rev E beta 7 safe.xls"
    Set myTextFile = Workbooks.Open("X:\Inspection Reports\test\Beta version\" & file_name)
    'this creates a collection of all filenames to be processed

    Dim loopFolder As String
    Dim fileNm As Variant
    Dim myFiles As New Collection
   
    'don't forget the backslash before the final double-quote below
    loopFolder = ThisWorkbook.Sheets("Sheet1").Cells(3, 4) 'this is where the folder location is stated
    fileNm = Dir(loopFolder & "*.xls")

    Do While fileNm <> ""
        myFiles.Add fileNm
        fileNm = Dir
    Loop
    Application.DisplayAlerts = False
        'this loops through all filenames
    Dim wb As Workbook
    insp_report_name = ""
    For Each fileNm In myFiles
        Set wb = Workbooks.Open(Filename:=(loopFolder & fileNm))  'open each workbook in the folder
        'check to see if the 'Update Reports' button was removed.  If it was then we should update manually
        On Error Resume Next 'incase shape does not exist
        Set shp = wb.Sheets("Input Sheet").Shapes("Button 314")
        If shp Is Nothing Then
        MsgBox "Shape does not exist."
        wb.Close
        Else
        wb.Sheets("Input Sheet").Range("A5:I13").Copy _
        myTextFile.Sheets("Input Sheet").Range("A5")        'copy input sheet data to new sheet
        wb.Sheets("Input Sheet").Range("A15:E23").Copy _
        myTextFile.Sheets("Input Sheet").Range("A16")
        wb.Sheets("Input Sheet").Range("F15:I23").Copy _
        myTextFile.Sheets("Input Sheet").Range("F15")
        wb.Sheets("Input Sheet").Range("E30:E37").Copy _
        myTextFile.Sheets("Input Sheet").Range("E31")
        wb.Sheets("Insp. Sheet Final").Range("B1:B3").Copy _
        myTextFile.Sheets("Insp. Sheet Final").Range("B1")          'copy final sheet info
        'wb.Sheets("Insp. Sheet Final").Range("B5:B7").Copy _
        'myTextFile.Sheets("Insp. Sheet Final").Range("B4")         'don't need job number or order/ship qtys
       
        If wb.Sheets("Input Sheet").Checkbox8 = True Then        'check to sheet if checkboxes in input sheet are checked and make new insp sheet the same
        If wb.Sheets("Input Sheet").CheckBox11 = True Then
        myTextFile.Sheets("Input Sheet").CheckBox10 = False
        myTextFile.Sheets("Input Sheet").Cells(41, 3) = 2
        myTextFile.Sheets("Input Sheet").Cells(28, 2) = 0.0003
        End If
        Else
        myTextFile.Sheets("Input Sheet").CheckBox9 = True                           'code from checkboxes
        myTextFile.Sheets("Input Sheet").Rows("25:38").EntireRow.Hidden = True
        myTextFile.Sheets("Input Sheet").Shapes("Check Box 1214").OLEFormat.Object.Visible = False
        myTextFile.Sheets("Input Sheet").Shapes("Check Box 1215").OLEFormat.Object.Visible = False
        myTextFile.Sheets("Input Sheet").Shapes("Check Box 1216").OLEFormat.Object.Visible = False
        myTextFile.Sheets("Input Sheet").Shapes("Check Box 1217").OLEFormat.Object.Visible = False
        myTextFile.Sheets("Input Sheet").Shapes("Check Box 1218").OLEFormat.Object.Visible = False
        myTextFile.Sheets("Input Sheet").Shapes("Check Box 1219").OLEFormat.Object.Visible = False
        myTextFile.Sheets("Input Sheet").Shapes("Check Box 1220").OLEFormat.Object.Visible = False
        myTextFile.Sheets("Input Sheet").Shapes("Check Box 1221").OLEFormat.Object.Visible = False
        myTextFile.Sheets("Input Sheet").OLEObjects("Checkbox10").Visible = False
        myTextFile.Sheets("Input Sheet").OLEObjects("Checkbox11").Visible = False
        myTextFile.Sheets("Input Sheet").Cells(42, 3) = 2
        End If
       
        insp_report_name = wb.Name  'record name of specific insp report
        wb.Close                    'close specific insp report
        Kill loopFolder & insp_report_name     'delete specific insp report
        myTextFile.SaveAs Filename:=loopFolder & insp_report_name    'save new inspection report as specific insp report name
        Application.Run ("'" & myTextFile.Name & "'!Update")
        Sheets("Insp. Sheet Final").Activate
        myTextFile.Save
        End If
    Next
    Application.DisplayAlerts = True
End Sub

 

[Kenneth Hobson]

While there a few speed tricks you can use, they will not help much I suspect. Copy and paste takes time. If you just retrieve data, that is faster.

Standard speed tips:

Option Explicit
'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
Public glb_origCalculationMode As Integer

Sub SpeedOn(Optional StatusBarMsg As String = "Running macro...")
  glb_origCalculationMode = Application.Calculation
  With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    .Cursor = xlWait
    .StatusBar = StatusBarMsg
    .EnableCancelKey = xlErrorHandler
  End With
End Sub

Sub SpeedOff()
  With Application
    .Calculation = glb_origCalculationMode
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
    .CalculateBeforeSave = True
    .Cursor = xlDefault
    .StatusBar = False
    .EnableCancelKey = xlInterrupt
  End With
End Sub

Sub Yours()
    On Error GoTo EndSub
    SpeedOn
    
' your stuff here
    
EndSub:
    SpeedOff
End Sub

What does the Update macro code look like?

You can use With to reference an object like a workbook or worksheet which may help a small bit.

Collections are slow. There are faster folder iteration methods but 5s vs. 0.01s is not all that much benefit for a one-time folder iteration I suspect.

FWIW, Select, Selection, Activate, and such are seldom needed and often slow macros down.

 

[rpbenz]

I have an Excel sheet that functions as an interface to a PLC (Programable Logic Controller). The main screen is populated with VBA code, finding TAG names on another sheet then pasting those names on the main screen. I had been using a simple do loop to find the start of the applicable names. Everything was fine until sometime between v1905 and v2012. V2012 do loop processing is at least 100times longer, 10 seconds instead of .1! What is going on with Excel Microsoft???

I understand to avoid do loops, and wasn't too worry about speed, figuring that when I had time Id optimize and get rid of many of the do loops, but processors are getting faster and software getting better - boy was I wrong. It appears that newer versions of Excel are being bloated with crappy code by the Microsoft "wizzards" The performance hit is freaking insane/pathetic. Gone back to version 1902 1806 and even earlier and everything works great.