Get all files in a folder and subfolders - excel

Question

I want to do the following:
Prompt user to choose a folder
Loop through folder (and subfolders if they exist)
Get all .xlsx files
Get specific column from those files (all have the same structure) and combine data from that column
I get all subfolders and all files but I get 5 times as much as I should.
L column is where I get all my data and Insert into Identical Master File (into L column).
I have 5 files - I should get 5 items in the last column, I simply add new folder in it, and same files(copied), so now I should get 10 items in the last column, instead I get 50.
Sub LoopThroughFolder()
Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
Dim Rws As Long, Rng As Range, r As Range
Set Wb = ThisWorkbook: Wb.Sheets(2).Range("L:L").ClearContents
Dim FSO As Object, fld As Object, Fil As Object
Dim wbkCS As Workbook
Dim FolderPath As String
Dim fsoFile As Object
Dim fsoFol As Object
Dim fileName As String
Dim sWb As Workbook
Dim MatchingColumn As Range
Dim MatchingRowNb As Long
MsgBox "Choose a folder: "
Application.DisplayAlerts = False
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\Users\"
.AllowMultiSelect = False
If .Show <> -1 Then
MsgBox "No folder selected! Exiting script."
Exit Sub
End If
FolderPath = .SelectedItems(1)
End With
If Right(FolderPath, 1) <> "\" Then
FolderPath = FolderPath + "\"
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
Set fld = FSO.GetFolder(FolderPath)
If FSO.FolderExists(fld) Then
For Each fsoFol In FSO.GetFolder(FolderPath).SubFolders
For Each fsoFile In fsoFol.Files
If Mid(fsoFile.Name, InStrRev(fsoFile.Name, ".") + 1) = "xlsx" Then
fileName = fsoFile.Name
Application.ScreenUpdating = False
MyDir = FolderPath 'fld
fileName = Dir(MyDir & "*.xlsx")
ChDir MyDir
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While fileName <> ""
Set sWb = Workbooks.Open(fileName)
With sWb.Worksheets(2)
Rws = .Cells(Rows.Count, 12).End(xlUp).Row
Set Rng = Range(.Cells(5, 1), .Cells(Rws, 12))
End With
With Wb.Worksheets(2)
Set MatchingColumn = .Range(.Cells(5, 1), .Cells(.Rows.Count, 1).End(xlUp))
For Each r In Rng.Rows
If r.Cells(1, 1).Value2 <> vbNullString Then 'Ignoring empty rows
If r.Rows.Hidden = False Then
'We find the row where the Ids matche
MatchingRowNb = Application.Match(r.Cells(1, 1).Value2, MatchingColumn, False)
'We add the current value in the cell with the new value comming from the other file
.Cells(4 + MatchingRowNb, 12).Value2 = .Cells(4 + MatchingRowNb, 12).Value2 + r.Cells(1, 12).Value2
End If
End If
Next
End With
sWb.Close SaveChanges:=True
Application.DisplayAlerts = True
fileName = Dir()
Loop
End If
Next
Next
End If
End Sub

Answer 1

You're using both FSO and Dir() to loop over the files, so that's why you're getting the same files over and over.
When your sub ends up doing a bunch of things (particularly when one thing is nested in another, and so on) then it's best to consider splitting it up, so you can concentrate on the one thing that's giving you problems, without all the other things "getting in the way".
Here's a stripped-down version to show what I mean. It works but for clarity doesn't have your file processing code.
Option Explicit
Sub LoopThroughFolder()
Dim Wb As Workbook, sWb As Workbook
Dim FolderPath As String
Dim colFiles As Collection, f
'get a folder
FolderPath = ChooseFolder()
If Len(FolderPath) = 0 Then
MsgBox "No folder selected: exiting"
Exit Sub
End If
'find all excel files in subfolders of that folder
Set colFiles = FileMatches(FolderPath, "*.xlsx")
If colFiles.Count = 0 Then
MsgBox "No xlsx files found"
Exit Sub
End If
Set Wb = ThisWorkbook
Wb.Sheets(2).Range("L:L").ClearContents
'loop over the files we found
For Each f In colFiles
Set sWb = Workbooks.Open(f.Path)
'process the file here
sWb.Close SaveChanges:=True
Next f
End Sub
Function ChooseFolder() As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose a folder"
.InitialFileName = "C:\Users\"
.AllowMultiSelect = False
If .Show = -1 Then
ChooseFolder = .SelectedItems(1)
If Right(ChooseFolder, 1) <> "\" Then _
ChooseFolder = ChooseFolder + "\"
End If
End With
End Function
'Return a collection of file objects given a starting folder and a file pattern
' e.g. "*.txt"
'Pass False for last parameter if don't want to check subfolders
Function FileMatches(startFolder As String, filePattern As String, _
Optional subFolders As Boolean = True) As Collection
Dim fso, fldr, f, subFldr
Dim colFiles As New Collection
Dim colSub As New Collection
Set fso = CreateObject("scripting.filesystemobject")
colSub.Add startFolder
Do While colSub.Count > 0
Set fldr = fso.getfolder(colSub(1))
colSub.Remove 1
For Each f In fldr.Files 'get files in folder
If UCase(f.Name) Like UCase(filePattern) Then colFiles.Add f
Next f
If subFolders Then 'get subfolders for processing?
For Each subFldr In fldr.subFolders
colSub.Add subFldr.Path
Next subFldr
End If
Loop
Set FileMatches = colFiles
End Function