VBA loop to get data from files - need speed improvement

[CodyMonster]

Hey everyone.
This is the first time I've written something that goes out onto a server and pulls data from multiple files.
Basically I have multiple file folders, over 130, that may or may not have a sub-dir that is called "restatement reports" where inside that sub-dir multiple excel files sit. And there are multiple tabs in each excel file that I'm pulling data from.

I've gotten the below script to work, however, it's really slow! And I occasionally get the "code execution has been interrupted" errors.
There must be a better way to accomplish what I'm doing.
If anyone has any ideas on ways to speed this up I would greatly appreciate it!

Thanks for all your help!

Sub GetData()


    Dim fso As New FileSystemObject
    Dim f As Object, sf As Object, ssf As Folder
        Dim ofile As File
    Dim MyPath As String, MyFile As String, File As Workbook
  
    
    
    Dim LeaseName As String
    Dim LeaseNum As Integer
    Dim Sh As Worksheet
    Dim ShName1 As String
    Dim WB As Workbook
    
    Application.EnableCancelKey = xlDisabled '<-- to avoid "Code execution has been interrupted" error
        
    Set WB = Workbooks("BLM_Data_tool") '<-- current sheet


    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder("F:\Work\MMP Project\BLM")
       Set fcount = f.SubFolders
       x = fcount.Count
    For Each sf In f.SubFolders
        For Each ssf In sf.SubFolders
            If ssf = sf & "\Restatement Reports" Then
                For Each ofile In ssf.Files
                    If ofile.Name Like "*2016.*" Then
                        If fso.GetExtensionName(ofile.Path) = "xlsx" Then
                         Debug.Print ofile.Name
                         Workbooks.Open ofile
                         ShName1 = WB.Sheets("datefinder").Range("E2").Value '<-- to get name of sheet - in this case Jan 16
                         Workbooks(ofile.Name).Activate
                          For Each Sh In ActiveWorkbook.Worksheets
                          
                                If Sh.Name Like ShName1 Then
                                Workbooks(ofile.Name).Sheets(ShName1).Select
                                Set LeaseFind = Range("A1:zz10000").Find(what:="Lease Name:", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows)
                                Set LeaseNumb = Range("A1:zz10000").Find(what:="Lease No.", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows)
                                Set NymexPx = Range("A1:zz10000").Find(what:="NYMEX Price", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows)
                                
                                NymexRow = NymexPx.Row + 1
                                NymexCol = NymexPx.Column
                                lastRow = Cells(NymexRow, NymexCol).End(xlDown).Row
                                LeaseName = Range(LeaseFind.Address).Offset(0, 1).Value
                                LeaseNumber = Range(LeaseNumb.Address).Offset(0, 1).Value
                                
                                Range("A" & NymexRow, "AA" & lastRow).Copy
                                
                                
                                Set loadtime = WB.Sheets("data").Range("A:AA").Find(what:="Load time at Lease", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows)
                                loadtimecol = loadtime.Column - 1
                                lasttimeRow = WB.Sheets("Data").Cells(Rows.Count, loadtimecol + 1).End(xlUp).Row + 1
                                lastlnameRow = WB.Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row + 1
                                lastlNumberRow = WB.Sheets("data").Cells(Rows.Count, 2).End(xlUp).Row + 1
                                
                                WB.Sheets("data").Cells(lasttimeRow, loadtimecol).PasteSpecial xlPasteValues
                                WB.Sheets("data").Cells(lastlnameRow, 1).Value = LeaseName
                                WB.Sheets("data").Cells(lastlNumberRow, 2).Value = LeaseNumber
                                lasttimeRow = WB.Sheets("Data").Cells(Rows.Count, loadtimecol + 1).End(xlUp).Row
                                WB.Sheets("Data").Activate
                                SendKeys "{ESC}"
                                WB.Sheets("data").Range("A" & lastlnameRow).AutoFill Destination:=Range("A" & lastlnameRow & ":A" & lasttimeRow)
                                WB.Sheets("data").Range("B" & lastlNumberRow).AutoFill Destination:=Range("B" & lastlNumberRow & ":B" & lasttimeRow)
                                
                                End If
                            Next


                        End If
                        Workbooks(ofile.Name).Close SaveChanges:=False
                        x = x - 1 '<-- to stop the loop if all the flies are done and x hits zero
                        Debug.Print x
                        If x = 0 Then
                            Exit Sub
                        End If


                    End If
                Next
            End If
        Next
    Next


End Sub

 

[PatOBrien198]

Have you tried....

'before your loop starts
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False


'then after the loop is done...
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

 

[CodyMonster]

Thanks.. yeah. I put that in this morning. It helps. But I'm sure it can be quicker. I get a lot of "excel not responding" during the process..etc. I think having to open up each file is creating a drag on the process. But I don't know how else to avoid this.

Thanks for the input!