Collecting all relevant data from xlsm files Is there a way to speed this guy up? The code is designed to go into a directory, open up all of the .xlsm files in the folder, and copy specific data into a target file. This code works as is, but it is extremely slow. Is there a way to speed it up?



Const FOLDER_PATH = "C:\Users\maxd\OneDrive - Nortek, Inc\Coil Test Data\coils_35_and_36\36\WET\Testing\"  'REMEMBER END BACKSLASH


Sub ImportWorksheets()
   '=============================================
   'Process all Excel files in specified folder
   '=============================================
   Dim sFile As String           'file to process
   Dim wsTarget As Worksheet
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim rowTarget As Long         'output row

   rowTarget = 11

   'check the folder exists
   If Not FileFolderExists(FOLDER_PATH) Then
      MsgBox "Specified folder does not exist, exiting!"
      Exit Sub
   End If

   'reset application settings in event of error
   On Error GoTo errHandler
   Application.ScreenUpdating = False

   'set up the target worksheet
   Set wsTarget = Sheets("Sheet1")

   'loop through the Excel files in the folder
   sFile = Dir(FOLDER_PATH &amp; "*.xlsm*")
   Do Until sFile = ""

      'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
      Set wbSource = Workbooks.Open(FOLDER_PATH &amp; sFile)
      Set wsSource = wbSource.Worksheets("Report")


      'import the data
      With wsTarget
         .Range("A" &amp; rowTarget).Value = wsSource.Range("E9").Value 'Year
         .Range("B" &amp; rowTarget).Value = wsSource.Range("D30").Value 'CFM
         '.Range("D" &amp; rowTarget).Value = wsSource.Range("D30/(30*30/144)").Value 'Face Velocity
         .Range("E" &amp; rowTarget).Value = wsSource.Range("D36").Value 'AVG Capacity
         .Range("F" &amp; rowTarget).Value = wsSource.Range("D29").Value 'APD
         .Range("G" &amp; rowTarget).Value = wsSource.Range("D34").Value 'WPD
         .Range("H" &amp; rowTarget).Value = wsSource.Range("D22").Value 'Inlet db
         .Range("I" &amp; rowTarget).Value = wsSource.Range("D23").Value 'Inlet  wb
         '.Range("J" &amp; rowTarget).Value = wsSource.Range("").Value 'Inlet dp
         .Range("K" &amp; rowTarget).Value = wsSource.Range("L16").Value 'Inlet WT
         .Range("L" &amp; rowTarget).Value = wsSource.Range("L17").Value 'Outlet WT
         .Range("M" &amp; rowTarget).Value = wsSource.Range("L22").Value 'Heat Balance





         'optional source filename in the last column
         .Range("N" &amp; rowTarget).Value = sFile
      End With

      'close the source workbook, increment the output row and get the next file
      wbSource.Close SaveChanges:=False
      rowTarget = rowTarget + 1
      sFile = Dir()
   Loop


'Loop for face velocity
  Dim r As Integer
  Dim i As Integer

i = Cells(Rows.Count, 1).End(xlUp).Row
    For r = 11 To i
        Cells(r, 4) = "=RC[-2]/(30*30/144)"
    Next r



errHandler:
   On Error Resume Next
   Application.ScreenUpdating = True

   'tidy up
   Set wsSource = Nothing
   Set wbSource = Nothing
   Set wsTarget = Nothing




End Sub




Private Function FileFolderExists(strPath As String) As Boolean
    If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function
It's been a while since I wrote VBA, but I seem to remember Application.Calculation = xlCalculationManual often sped up my programs considerably. This prevents formulae from being evaluated while you're updating cell values, and can be reversed via Application.Calculation = xlCalculationAutomatic.