Help optimizing this code

Hello,

This code opens a new workbook, loops throughout all excel workbooks in a folder, opens the first one, loops throughout the cells of the table of the first worksheet and if the conditional formatting color is the desired, copies the cell value from the first column which is an ID to the new workbook.

It's basically so I can know what IDs are still undone in all the files.

It works but as more files are added to the folder, the slower it gets (at the beginning I call another subprocedure to turn things off like events, screen updating and so on which I ommited here). It's still faster than checking manually each file but maybe it can be optimized somehow. I thought of trying with an array but don't know exactly how I could do it.

Sub importPendingCases()

Dim newWbk As Workbook
Set newWbk = Workbooks.Add

Dim newWks As Worksheet
Set newWks = newWbk.Sheets(1)

Dim MyFiles As String

MyFiles = Dir("FolderPath*.xlsx.lnk")

Do While MyFiles <> ""
    
    Dim wbk As Workbook
    Set wbk = Workbooks.Open("FolderPath" & MyFiles, False, False)
    wbk.Activate
    
    Dim wks As Worksheet
    Set wks = wbk.Sheets(1)

    Dim tbl As ListObject
    Set tbl = wks.ListObjects("Table1")
    
    Dim rng As Range
    Set rng = tbl.DataBodyRange
    
    With rng
    
        Dim tRows As Long
        tRows = .Rows.Count
    
    End With
    
    Dim r As Long
                
    For r = 1 To tRows
    
        Dim c As Range
        
        For Each c In rng.Cells(r, 1)
        
            If c.DisplayFormat.Interior.Color = 45559 Then
                
                Dim lastRow As Long
                
                lastRow = newWks.Cells(Rows.Count, 1).End(xlUp).Row
                
                newWks.Range("A" & lastRow + 1).Value = wks.Range("A" & r + 1).Value
            
            End If
            
         Next c
    
    Next r

    wbk.Close False

    MyFiles = Dir
    
Loop

End Sub

This question really should be a FAQ. I see it time and time again and looping just isn't the best way of doing this sort of thing.

Whenever you find yourself creating looping code stop and think is this really necessary? Most of the time it isn't. Loops are inherently slow when they have to jump back and forth between VBA and the Excel application - there's a big time overhead at each pass through the loop.

The fastest, most efficient and elegant way for this sort of stuff is to use an Autofilter to filter the rows you're interested in.
Then use syntax like

Range("your_range").SpecialCells(xlCellTypeVisible).Copy

then paste to your destination cell.

This uses just one Copy / Paste instruction rather than many if you're looping through many cells.

I also think it's risky to use colours to identify cells, there are far too many. There's presumably some other marker, like the absence of a value in a cell that could be used to Autofilter the rows/range you need.

Originally Posted by mike-lowski

Thanks Richard. Indeed looping is hell most of the time.

Indeed, and if you need to use a loop because things are slow then read all the data into a VBA array and process the array with the loop saving results into a Results Array and at the end copy the Results array back to the desired Excel range.