I have several .xlsm templates in a folder. I'm trying to read through all the excel files in that folder and based on the type of the file, it reads through all the sheets in each file and copy specific cells into another my active workbook (ThisWorkbook). Following is my code and it is working correctly. However it is super slow. I'm looking for any solution that can speed up the code. I've already tried Application.ScreenUpdating = False but still it is very slow. It takes about 10 min for 20 files to be processed. DO you guys have any suggestion on how to increase the speed. Thanks Veru mich in Advance ...
Application.ScreenUpdating = False
FileType = "*.xls*"
OutputRow = 5
Range("$B$6:$M$300").ClearContents
filepath = Range("$B$3") & "\"
ThisWorkbook.ActiveSheet.Range("B" & OutputRow).Activate
OutputRow = OutputRow + 1
Curr_File = Dir(filepath & FileType)
Do Until Curr_File = ""
Set FldrWkbk = Workbooks.Open(filepath & Curr_File, False, True)
ThisWorkbook.ActiveSheet.Range("B" & OutputRow) = Curr_File
OutputRow = OutputRow
For Each sht In FldrWkbk.Sheets
ThisWorkbook.ActiveSheet.Range("C" & OutputRow) = sht.Name
If Workbooks(Curr_File).Worksheets(sht.Name).Range("B7") = "Project Number" Then
For i = 1 To 4
If IsEmpty(Workbooks(Curr_File).Worksheets(sht.Name).Cells(10, 5 + 2 * i)) = False Then
With Workbooks(Curr_File).Worksheets(sht.Name)
MyE = .Cells(10, 5 + 2 * i).Value
MyF = .Cells(11, 5 + 2 * i).Value
End With
With ThisWorkbook.ActiveSheet
.Range("D" & OutputRow).Value = "Unit Weight"
.Range("E" & OutputRow).Value = MyE
.Range("F" & OutputRow).Value = MyF
End With
OutputRow = OutputRow + 1
End If
Next
OutputRow = OutputRow - 1
ElseIf Workbooks(Curr_File).Worksheets(sht.Name).Range("C6") = "PROJECT NUMBER" Then
With Workbooks(Curr_File).Worksheets(sht.Name)
MyE = .Range("$H$9").Value
MyF = .Range("$B$9").Value
End With
With ThisWorkbook.ActiveSheet
.Range("D" & OutputRow).Value = "Specific Gravity"
.Range("E" & OutputRow).Value = MyE
.Range("F" & OutputRow).Value = MyF
End With
ElseIf Workbooks(Curr_File).Worksheets(sht.Name).Range("C6") = "Project Number" Then
With Workbooks(Curr_File).Worksheets(sht.Name)
MyE = .Range("$E$4").Value
MyF = .Range("$R$4").Value
MyG = .Range("$R$5").Value
End With
With ThisWorkbook.ActiveSheet
.Range("D" & OutputRow).Value = "Sieve & Hydrometer"
.Range("E" & OutputRow).Value = MyE
.Range("F" & OutputRow).Value = MyF
.Range("G" & OutputRow).Value = MyG
End With
ElseIf Workbooks(Curr_File).Worksheets(sht.Name).Range("A6") = "PROJECT NUMBER" Then
ThisWorkbook.ActiveSheet.Range("D" & OutputRow).Value = "Moisture Content"
Last = Workbooks(Curr_File).Worksheets(sht.Name).Cells(Rows.Count, "J").End(xlUp).Row
ThisWorkbook.ActiveSheet.Range("I" & OutputRow).Value =
Workbooks(Curr_File).Worksheets(sht.Name).Cells(Last, 10)
ElseIf Workbooks(Curr_File).Worksheets(sht.Name).Range("C5") = "Project Number" Then
With Workbooks(Curr_File).Worksheets(sht.Name)
MyE = .Range("$H$8").Value
MyF = .Range("$B$8").Value
MyG = .Range("$D$8").Value
End With
With ThisWorkbook.ActiveSheet
.Range("D" & OutputRow).Value = "Atterberg Limits"
.Range("E" & OutputRow).Value = MyE
.Range("F" & OutputRow).Value = MyF
.Range("G" & OutputRow).Value = MyG
End With
ElseIf Workbooks(Curr_File).Worksheets(sht.Name).Range("B5") = "Project Number" Then
With Workbooks(Curr_File).Worksheets(sht.Name)
MyE = .Range("$G$4").Value
MyF = .Range("$E$4").Value
MyG = .Range("$E$5").Value
End With
With ThisWorkbook.ActiveSheet
.Range("D" & OutputRow).Value = "Gradation Size"
.Range("E" & OutputRow).Value = MyE
.Range("F" & OutputRow).Value = MyF
.Range("G" & OutputRow).Value = MyG
End With
End If
OutputRow = OutputRow + 1
Next sht
FldrWkbk.Close SaveChanges:=False
Curr_File = Dir
Loop
Set FldrWkbk = Nothing
Application.ScreenUpdating = True
...
I Just realized that the slow performance is due to the formulations that are written in the excel but are linked to the ranges that are pasted from the Macro code. As it was addressed in the previous stack overflow solutions, I simply added "Application.Calculation = xlCalculationManual" in the beginning of the code and "Application.Calculation = xlCalculationAutomatic" at the end of the code and now it is much much faster.
I hope it is also useful to whom is reading this