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
Bookmarks