Below is the code I am using to run through files in a folder, pull information from the files, and record that information on a sheet. I am not the original author of the main portion of the code. The files the code is opening are fairly large and there are 1000+ of them. I also hard coded the cells the code is pulling information from.
Is there any way to make this code run more efficiently?
Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim PartInfoArr() As Long
Dim ArrCount As Integer
Dim PartNum As Integer
Dim i As Integer
Dim DocDate As String
Dim j, r As Integer
Dim SeenPart, SeenCount As Integer
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
ArrCount = 0
'folder path for where to pull files from
myPath = "C:\Users\.........."
'Target File Extension (must include wildcard "*")
myExtension = "*.xlsm*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
'Coppy all file information
Sheets("Tool GT Block").Select
Range("B11:C11").Select
'While there are part numbers record all info for each into arry
While ActiveCell.Offset(i, 0) <> ""
Workbooks("MTM File.xlsm").Worksheets("MTM Pack Process Data").Range("A2").Offset(k, 0) = ActiveCell.Offset(i, 0)
DocDate = Range("D8")
Workbooks("MTM File.xlsm").Worksheets("MTM Pack Process Data").Range("A2").Offset(k, 1) = DocDate
Workbooks("MTM File.xlsm").Worksheets("MTM Pack Process Data").Range("A2").Offset(k, 2) = Range("D11")
Workbooks("MTM File.xlsm").Worksheets("MTM Pack Process Data").Range("A2").Offset(k, 3) = Range("I9")
Workbooks("MTM File.xlsm").Worksheets("MTM Pack Process Data").Range("A2").Offset(k, 4) = Range("I10")
Workbooks("MTM File.xlsm").Worksheets("MTM Pack Process Data").Range("A2").Offset(k, 5) = Range("I12")
Workbooks("MTM File.xlsm").Worksheets("MTM Pack Process Data").Range("A2").Offset(k, 6) = Range("I13")
Workbooks("MTM File.xlsm").Worksheets("MTM Pack Process Data").Range("A2").Offset(k, 8) = Range("I15")
Workbooks("MTM File.xlsm").Worksheets("MTM Pack Process Data").Range("A2").Offset(k, 9) = Range("I16")
Workbooks("MTM File.xlsm").Worksheets("MTM Pack Process Data").Range("A2").Offset(k, 10) = Range("I17")
Workbooks("MTM File.xlsm").Worksheets("MTM Pack Process Data").Range("A2").Offset(k, 11) = Range("I18")
Workbooks("MTM File.xlsm").Worksheets("MTM Pack Process Data").Range("A2").Offset(k, 12) = Range("I21")
'min packing processing overall
Workbooks("MTM File.xlsm").Worksheets("MTM Pack Process Data").Range("A2").Offset(k, 13) = Range("R10")
i = i + 1
k = k + 1
Wend
' reset var for next file
i = 0
'Save and Close Workbook
wb.Close SaveChanges:=False
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
'Message Box when tasks are completed
MsgBox "Task Complete!"
End Sub
2 Answers 2
Preamble
The first step to optimizing this code is most likely not something you'll think helpful. It's generally accepted wisdom among the regular VBA reviewers here that writing code should follow a three step-process:
- Make it work
- Make it right
- Make it fast
The problem with the code you presented is that it's really long and hard to understand (and accordingly optimize). Basically you're jumping the gun and try to run before you walked.
Constants
Constants are values that can be known at compile time and that do not change when the macro is run. You should extract such values into module-level constants like so:
Private Const myPath As String = "C:\Users\...."
Private Const myExtension As String = "*.xlsm"
' ... ?
Variable definitions
It's great that you're declaring your variables. I didn't see an Option Explicit though. It's generally cleaner and easier to require variable declarations to prevent bugs from misspellings and other quirks. Use any security that the language can give you.
In addition to that there's a small weirdness about VBA and As-Declarations:
Dim j, r As Integer Dim SeenPart, SeenCount As Integer
This code actually will make the types of r and SeenCount Integer, but j and SeenPart will be declared and used as Variant, which can slow your program down.
To prevent this behaviour from ruining your day, I'd recommend declaring each variable on a separate line.
Last but not least: Integer is a 16-bit signed integer. Modern CPUs are highly optimized for arithmetics on 32-bit signed (and unsigned) integers. Surprisingly often it's faster in VBA to use Long over Integer.
Submethods
To make code easier to follow, it helps to keep the lifetime of variables and constructs as small as possible. This reduces the load on the reader's short-term memory and keeps capacity free to think about what the code actually means instead of just being preoccupied with which variables are actually relevant here.
Overall you should strive to make procedures as short as possible by extracting common code into a new procedure.
Consider:
Sub LoopAllExcelFilesInFolder()
On Error GoTo ResetSettings
OptimizeMacroSpeed()
AggregateData()
ResetSettings:
ReinstituteApplicationState()
On Error GoTo 0
End Sub
This is very easy to understand at the first reading. Of course it doesn't contain all information that you need, but it helps you understand the overall goal of the code. Now AggregateData could read something like this:
Sub AggregateData()
Dim myFile As String
myFile = Dir(myPath & myExtension)
Do While myFile <> ""
Dim workbook As Workbook
Set workbook = Workbooks.Open(Filename := myPath & myFile)
' Ensure workbook has opened
DoEvents
CopyData(workbook)
workbook.Close SaveChanges := False
' Ensure workbook has closed
DoEvents
myFile = Dir
Loop
End Sub
At this point it should be fairly obvious what CopyData should be doing, so I won't elaborate further :)
Finally Optimizations
First things first: Accessing a Worksheet is slow. Accessing a Workbook also is. What you accordingly want to do is minimize the number of times you do so.
Since VBA is an interpreted language (after having been compiled to p-code), every instruction is executed independently. This means that the copy-process is terrifyingly slow:
Workbooks("MTM File.xlsm").Worksheets("MTM Pack Process Data").Range("A2")
^^ this code is executed every single line, which means a tremendous overhead.
Luckily VBA has a builtin mechanism to help us with this:
With Workbooks("MTM File.xlsm").Worksheets("MTM Pack Process Data").Range("A2")
.Offset(k, 0) = ActiveCell.Offset(i, 0)
.Offset(k, 1) = Range("D8")
.Offset(k, 2) = Range("D11")
' ...
End With
Instead of executing the whole chain of Workbooks(..).Worksheets(..).Range("A2") every line, now VBA executes the chain only once and keeps a reference of that object in the with-block. This object can now be accessed directly and most of the overhead is removed.
A word of caution
The word of caution also is a possible optimization... Working with Selection and ActiveWorkbook and ActiveWorksheet is downright dangerous. In the middle of macro execution, your user could click on things, change the reference and suddenly data is not where you expect it anymore and everything breaks.
To prevent that you should always (read: whenever possible) keep a reference to a Range or Worksheet you're working with in a variable. That is pretty safe from the user and also allows for some minor optimizations.
k is undeclared.
Always use Option Explicit to ensure undeclared variables are caught at run-time. You can make sure Option Explicit is added to the top of every module by ticking the "Require Variable Declaration setting in Tools -> Options... An added bonus is that if you use CamelCase when declaring variables and lowercase when typing them in your code, you get instant visual feedback if you type an undeclared variable.
PartInfoArr(), ArrCount, PartNum, SeenPart, SeenCount, j and r are not used. I've deleted their declarations.
I've used constants as suggested by @vogel612.
DocDate = Range("D8") was only used once so I've deleted it.
Do Events passes control to the operating system. Control is returned after the operating system has finished processing the events in its queue and all keys in the SendKeys queue have been sent. In VBA commands are executed sequentially so Do Events is not required to "Ensure Workbook has opened before moving on to next line of code". That said, it is good practice to include it within loops to allow code execution to be interrupted by pressing Ctrl Break if you get into an unintended infinite loop.
Don't use Select. Set Sheet or Range variables instead and use With... End With constructs where appropriate. When using With... End With make sure you precede the object properties or methods with a period otherwise you may get unexpected results
Don't use ActiveCell - set a Range variable and use it.
While ActiveCell.Offset(i, 0) <> "" only makes sense if you have another Part No in B12 and beyond.
As the values being copied don't change for each iteration of i, reading them into an array before entering the loop to reduce the size of the loop.
I've declared CopyArray(1 to 13) as Variant but if your data allows, declare it as a specific type (e.g. Long, String, Double).
Note that Select is not used anywhere in the following code!
Option Explicit
Private Const myPath As String = "C:\Users\....\"
Private Const myExtension As String = "*.xls*"
Sub CopyFromExcelFilesInFolder()
Dim myFile As String
Dim SourceWB As Workbook
Dim SourceSht As Worksheet
Dim SourceRefCell As Range
Dim DestWB As Workbook
Dim DestSht As Worksheet
Dim DestRefCell As Range
Dim i As Long 'Integer type is obsolete
Dim k As Long 'declare k
Dim CopyArray(1 To 13) As Variant 'change to String, Long etc. as appropriate.
NeedForSpeed
On Error GoTo ResetSettings:
Set DestWB = ThisWorkbook
Set DestSht = DestWB.Sheets("MTM Pack Process Data")
Set DestRefCell = DestSht.Range("A2")
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'explicitly initialize k. Not absolutely necessary but for clarity
k = 0
'Loop through each Excel file in folder
Do While myFile <> ""
If myFile <> ThisWorkbook.Name Then
Set SourceWB = Workbooks.Open(Filename:=myPath & myFile)
Set SourceSht = SourceWB.Sheets("Tool GT Block")
Set SourceRefCell = SourceSht.Range("B11")
'reset i
i = 0
With SourceSht
CopyArray(1) = .Range("D8")
CopyArray(2) = .Range("D11")
CopyArray(3) = .Range("I9")
CopyArray(4) = .Range("I10")
CopyArray(5) = .Range("I12")
CopyArray(6) = .Range("I13")
CopyArray(7) = ""
CopyArray(8) = .Range("I15")
CopyArray(9) = .Range("I16")
CopyArray(10) = .Range("I17")
CopyArray(11) = .Range("I18")
CopyArray(12) = .Range("I21")
CopyArray(13) = .Range("R10")
End With
'Write to DestinationWB While there are part numbers in SourceWB
While SourceRefCell.Offset(i, 0) <> ""
With DestRefCell
.Offset(k, 0) = SourceRefCell.Offset(i, 0)
DestSht.Range(.Offset(k, 1), .Offset(k, 13)) = CopyArray
End With
i = i + 1
k = k + 1
Wend
'Save and Close Workbook
SourceWB.Close SaveChanges:=False
End If
'allow user to Ctrl + Break out of unexpected infinite loop
DoEvents
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
ResetSpeed
End Sub
Sub NeedForSpeed()
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
End Sub
Sub ResetSpeed()
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
I haven't speed tested this against your code because I can't be bothered creating 1000+ workbooks. Please let me know if it is faster.
While ActiveCell.Offset(i, 0) <> ""makes no sense. It appears like you'll be making multiple copies of the same record. \$\endgroup\$