I have this simple looping macro, but I can't seem how to figure out how to make it run faster. I tried including more update = false statements as well as well as removing any selecting type behavior. Sub AbesLoop() Dim wbk As Workbook Dim ws As Integer Dim Filename As String Dim Path As String Dim rCell As Range Dim rRng As Range Dim wsO As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual Path = PathToFolder & \ Filename = Dir(Path & *.xl??) Set wsO = ThisWorkbook.Sheets(Sheet1) Do While Len(Filename) > 0     Set wbk = Workbooks.Open(Path & Filename, True, True)     ws = wbk.Worksheets.Count     For i = 1 To ws     Application.ScreenUpdating = False     Application.DisplayAlerts = False     Application.Calculation = xlCalculationManual     Set rRng = Range(b1:b20)         For Each rCell In rRng.Cells             If rCell <>  And rCell.Value <> Not Tested Then             wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = rCell             wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(0, 1).Value = rCell.Offset(0, -1)             wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(0, 2).Value = Right(ActiveWorkbook.FullName, 15)             End If         Next rCell     Next i     wbk.Close False     Filename = Dir Loop Application.ScreenUpdating = True Application.DisplayAlerts = True Application.Calculation = xlCalculationAutomatic End Sub
Looping through Files in a Folder
performance;vba;excel
This answer is just going to focus on what you asked for, how to speed up your code. I'm going to go through line by line and note anything that could be done to make it faster. Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual Path = PathToFolder & \ Filename = Dir(Path & *.xl??) Set wsO = ThisWorkbook.Sheets(Sheet1)You might want to add Application.EnableEvents = False.Other than that, nothing to change here, this is about as fast as it's ever going to get. Do While Len(Filename) > 0     Set wbk = Workbooks.Open(Path & Filename, True, True)     ws = wbk.Worksheets.Count     For i = 1 To ws     Application.ScreenUpdating = False     Application.DisplayAlerts = False     Application.Calculation = xlCalculationManual     Set rRng = Range(b1:b20)This is mostly fine, except why are you re-setting all the Application.Settings options to false? They haven't changed from 6 lines ago. Just cut them out.An obvious way to speed things up is not to open every worksheet in every workbook in this folder, but I'm going to assume that they are all required.Opening a workbook does take time. If you've got a lot of them to open, then this macro is going to take time to run no matter how much you optimise it.     For Each rCell In rRng.Cells         If rCell <>  And rCell.Value <> Not Tested Then         wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = rCell         wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(0, 1).Value = rCell.Offset(0, -1)         wsO.Cells(wsO.Rows.Count, 1).End(xlUp).Offset(0, 2).Value = Right(ActiveWorkbook.FullName, 15)         End If     Next rCellBy process of elimination, any performance problems not related to opening the workbooks will be found here.Fortunately, there are many things to be improved.My personal #1 rule of fast spreadsheet manipulations:Thou shalt not directly manipulate data in worksheetsBy this I mean, doing anything in a worksheet has huge computational overhead. In the VBA object heirarchy, worksheets are only 2 steps removed from the application object itself. There are layers upon layers of abstractions, events, handlers, objects (not to mention several Billion range objects) buried in a worksheet object, and any time you do something in it, it will trigger a cascade of operations to make sure that nothing in your worksheet gets messed up.For this reason, you should interact with worksheets as infrequently as possible. If there is data in your worksheet that you need to analyse: access the worksheet once to read the data into an Array, then do all your computations on the Array, then access the worksheet once to read the data back (if applicable).Your sub then goes like this:Sub AbesLoop()    Application.ScreenUpdating = False    Application.EnableEvents = False    Application.DisplayAlerts = False    Application.Calculation = xlCalculationManual    Dim targetBook As Workbook    Dim targetSheet As Worksheet    Dim sheetCount As Long    Dim targetFilename As String    Dim outputSheet As Worksheet    Set outputSheet = ThisWorkbook.Sheets(Sheet1) '/ Get this out of the way until we need it later    Dim sheetRange As Range    '/ Note the *descriptive*, *unambiguous* names.    '/================================================================================================================================================    '/================================================================================================================================================    '/ Create the main array object, define columns, insert headers.    Dim testOutputData As Variant    testOutputData = Array()    Dim testOutputRowIndex As Long    testOutputRowIndex = 1    ReDim testOutputData(1 To 3, 1 To testOutputRowIndex) '/ Defined it in a transposed state (column, row) because when extending arrays, if you want to preserve the data, you can only extend the final dimension.    Const CELL_VALUE_COLUMN As Long = 1    Const ADJACENT_CELL_VALUE_COLUMN As Long = 2 '/ It would really help when naming to know what this data actually is that you need to copy.    Const WORKBOOK_NAME_COLUMN As Long = 3    testOutputData(CELL_VALUE_COLUMN, testOutputRowIndex) = Cell Value    testOutputData(ADJACENT_CELL_VALUE_COLUMN, testOutputRowIndex) = Cell Value in adjacent (to left) column    testOutputData(WORKBOOK_NAME_COLUMN, testOutputRowIndex) = Workbook Name    '/================================================================================================================================================    '/================================================================================================================================================    Dim sheetData As Variant    sheetData = Array()    Dim i As Long, j As Long    Dim cellValue As Variant, adjacentCellValue As Variant    targetFilename = Dir(FOLDER_PATH & *.xl??)    Do While Len(targetFilename) > 0        Set targetBook = Workbooks.Open(FOLDER_PATH & targetFilename, True, True)        sheetCount = targetBook.Worksheets.Count        For i = 1 To sheetCount            Set targetSheet = targetBook.Sheets(i)            Set sheetRange = targetSheet.Range(a1:b20) '/ include the adjacent column in our data            sheetData = sheetRange            For j = 1 To 20                cellValue = sheetData(j, 2) '/ column a is in 1, so b is 2                If cellValue <>  And cellValue <> 0 And cellValue <> Null And cellValue Is Not Nothing And cellValue <> Not Tested Then '/ Check for other versions of [No Data]                    adjacentCellValue = sheetData(j, 1)                    testOutputRowIndex = testOutputRowIndex + 1                    ReDim Preserve testOutputData(1 To 3, 1 To testOutputRowIndex) '/ add an extra row to the end                    testOutputData(CELL_VALUE_COLUMN, testOutputRowIndex) = cellValue                    testOutputData(ADJACENT_CELL_VALUE_COLUMN, testOutputRowIndex) = adjacentCellValue                    testOutputData(WORKBOOK_NAME_COLUMN, testOutputRowIndex) = targetBook.Name                End If            Next j        Next i        targetBook.Close False        targetFilename = Dir    Loop    '/ --> [Transpose data array back to (row, column) form]. You can find a function on the internet or write your own.    '/ print final data array back to sheet    Set sheetRange = outputSheet.Range(Cells(1, 1), Cells(testOutputRowIndex, 3))    sheetRange = testOutputData    Application.ScreenUpdating = True    Application.DisplayAlerts = True    Application.EnableEvents = True    Application.Calculation = xlCalculationAutomaticEnd Sub