Macro to read files located in sub-folders

Question

.

Your coding worked. I saw a list of all the files within each sub-folder.

Please update the macro to perform the actual reading of the files.

Answer

I guess I should have mentioned that the reason I didn't send the revision is that the allexperts puked on it. So I guess it was too big with both versions. Here is your code with the sub-folder code integrated: ( I can't really test this since I don't have your files, but I would expect it to work).

Sub Collect_Dwg_List_Data() Dim Dest As Worksheet, sh As Worksheet Dim rw As Long, spath As String, sname As String Dim bk As Workbook Dim i As Long, j As Long Dim DirectoriesAndFiles As Variant Dim Directories As Variant Dim Count As Long Dim Counter As Long

Set Dest = ActiveSheet rw = 2 spath = "C:\Data files" '<== no slash on the end

ReDim DirectoriesAndFiles(1 To 1) ReDim Directories(1 To 1) Count = 0 Counter = 0

LookForDirectories spath, DirectoriesAndFiles, Directories, Count, Counter GetFilesInDirectory spath, DirectoriesAndFiles, Directories, Count, Counter

For j = LBound(DirectoriesAndFiles) To UBound(DirectoriesAndFiles) sname = DirectoriesAndFiles(j)

Set bk = Workbooks.Open(sname) For Each sh In bk.Worksheets For i = 11 To 50 If Len(Trim(sh.Cells(i, "B"))) > 0 Then

If Left(sh.Cells(i, "B"), 5) <> "XX-XX" Then
 Dest.Cells(rw, "A").Value = sh.Cells(i, "B").Value
 Dest.Cells(rw, "B").Value = sh.Cells(i, "F").Value
 Dest.Cells(rw, "F").Value = sh.Cells(i, "G").Value
 Dest.Cells(rw, "C").Value = sh.Range("C7").Value
 Dest.Cells(rw, "D").Value = sh.Range("G6").Value
 Dest.Cells(rw, "E").Value = sh.Range("H7").Value
 rw = rw + 1
End If

End If Next i Next sh bk.Close SaveChanges:=False Next j

Dest.Columns(2).NumberFormat = "0%" Dest.Columns(5).NumberFormat = "mm/dd/yyy" Dest.Columns(6).NumberFormat = "mm/dd/yyy"

End Sub

'=============================

Sub LookForDirectories(ByVal DirToSearch As String, _ DirectoriesAndFiles As Variant, Directories As Variant, _ Count As Long, Counter As Long)

   Dim i As Integer
   Dim Contents As String
   Dim oldCount As Long
   oldCount = Counter
   If Right(DirToSearch, 1) <> "\" Then _
   DirToSearch = DirToSearch & "\"
   Contents = Dir(DirToSearch, vbDirectory)
   Do While Contents <> ""
     If Contents <> "." And Contents <> ".." Then
       If (GetAttr(DirToSearch & Contents) And vbDirectory) = vbDirectory Then
            If Not IsEmpty(Counter) Then _
               Counter = Counter + 1
               ReDim Preserve Directories(1 To Counter)
               Directories(Counter) = DirToSearch & Contents
           End If
       End If
       Contents = Dir()
   Loop
   If Counter = 0 Then Exit Sub
   For i = oldCount + 1 To Counter
       GetFilesInDirectory Directories(i), _
         DirectoriesAndFiles, Directories, Count, Counter
       LookForDirectories Directories(i), _
         DirectoriesAndFiles, Directories, Count, Counter
   Next i

End Sub

'=====================================================================

Sub GetFilesInDirectory(ByVal DirToSearch As String, _ DirectoriesAndFiles As Variant, Directories As Variant, _ Count As Long, Counter As Long)

   Dim NextFile As String
   NextFile = Dir(DirToSearch & "\" & "*.xls?", vbHidden)
   Application.StatusBar = "Files Found " & Count _
       & "  " & "Searching " & DirToSearch & "\"
    Do Until NextFile = ""
     If Not IsEmpty(DirectoriesAndFiles) Then _
       Count = Count + 1
        ReDim Preserve DirectoriesAndFiles(1 To Count)
        DirectoriesAndFiles(Count) = DirToSearch & "\" & NextFile
        NextFile = Dir
    Loop

End Sub