How can I minimize the time to access a xlsm file?

Question

I have a macro that access some xlsm files to retrieve a spreadsheet and paste it as value. However, the macro is taking a lot of time to open - mainly because it take a lot of time to open each of the xlsm files. Is there any way I can reduce this load time?

This is the code I have:

Option Explicit

Sub GetSheets()
Dim Path As String
Dim Filename As String
Dim wbMaster As Workbook
Dim wbActive As Workbook
Dim wsPanel As Worksheet

Set wbMaster = ThisWorkbook

Path = "C:\Users\Admin\PMO\Test consolidation\Independent files"
If Right$(Path, 1) <> "\" Then Path = Path & "\"
Filename = Dir(Path & "*.xlsm")

Dim wsname As String
clean

Do While Filename <> ""
    Set wbActive = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
    'Workbook_Opn_DisableMacros (Path & Filename)

    With wbActive
        If Evaluate("ISREF('" & "Panel" & "'!A1)") Then 'Rory 'https://stackoverflow.com/questions/6688131/test-or-check-if-sheet-exists
            Set wsPanel = wbActive.Worksheets("Panel")
            wsPanel.Copy After:=wbMaster.Worksheets(1)

            If Not IsEmpty(wsPanel.Range("U5")) Then
                ActiveSheet.Name = wsPanel.Range("U5")
                Cells.Select
                Range("B3").Activate
                Selection.Copy
                Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, 
                Operation:=xlNone _
                , SkipBlanks:=False, Transpose:=False
                Selection.PasteSpecial Paste:=xlPasteValues, 
                Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Application.CutCopyMode = False
                ActiveSheet.Visible = False
            Else
                MsgBox "Missing value to rename worksheet in " & Filename
            End If
        End If
    End With

    wbActive.Close
    Filename = Dir()
    Loop
End Sub

Doing a quick search around, I found this code that apparently solves this but has been crashing my file.

Public Sub Workbook_Opn_DisableMacros(FileComplete As String)

Dim oldSecurity
oldSecurity = Excel.Application.AutomationSecurity
Excel.Application.AutomationSecurity = msoAutomationSecurityForceDisable
Excel.Workbooks.Open (FileComplete), ReadOnly:=True
Excel.Application.AutomationSecurity = oldSecurity
End Sub

Does anyone know how to merge this solution into my code? Any help is deeply appreciated. Thanks!

Have you tried just adding this line right after your Do While statement? Application.AutomationSecurity = msoAutomationSecurityForceDisable — mooseman, Dec 13 '17 at 16:21
Yes.. while it doesn't crash my file, it does not reduce the data fetching time — gosh, Dec 13 '17 at 16:42
Do the files take a long time to open, normally? I doubt VBA can speed up that process. — mooseman, Dec 13 '17 at 17:15

score 0 · Answer 1 · answered Dec 14 '17 at 14:56

Your code here:

            Cells.Select
            Range("B3").Activate
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, 
            Operation:=xlNone _
            , SkipBlanks:=False, Transpose:=False
            Selection.PasteSpecial Paste:=xlPasteValues, 
            Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Application.CutCopyMode = False
            ActiveSheet.Visible = False

is unnecessary. Firstly you are selecting all the cells in the activesheet - which is several million. Then you activate one cell to no purpose, then you copy those several million cells, paste them over the top as values, then do it again, and then hide the sheet. I don't know why you want to do this, but you can achieve the same end by doing:

   With Activesheet
        .usedrange.formula = .usedrange.value
        .visible = false
   End With

which ought to speed things up

How can I minimize the time to access a xlsm file?

1 Answers1