use this nethode:
Option Explicit Sub GetFolder(Folder As String, searchF As String, colFolder As Collection, ByRef counter As Long) Dim SubFolder, subF As New Collection, sf As String If Right(Folder, 1) <> "\" Then Folder = Folder & "\" If Dir(Folder & searchF, vbDirectory) <> "" Then colFolder.Add Folder & searchF & "\" sf = Dir(Folder, vbDirectory) Do While Len(sf) > 0 If sf <> "." And sf <> ".." Then If (GetAttr(Folder & sf) And vbDirectory) <> 0 Then Debug.Print Folder & sf counter = counter + 1 subF.Add Folder & sf End If End If sf = Dir() Loop For Each SubFolder In subF GetFolder CStr(SubFolder), searchF, colFolder, counter Next End Sub Public Sub TestMe() Dim newC As New Collection Dim colChecked As New Collection Dim counter As Long GetFolder "C:\Users\<username>\Desktop\BA Tools", "v", newC, counter Debug.Print counter End Sub
[More Info on https://stackoverflow.com/][1]

[1]: https://stackoverflow.com/questions/46645216/excel-vba-search-for-a-directory

I think you are underestimating the hierarchy size. Change your code to this one to see how many folders you are recursing through.
Option Explicit Sub GetFolder(Folder As String, searchF As String, colFolder As Collection, ByRef counter As Long) Dim SubFolder, subF As New Collection, sf As String If Right(Folder, 1) <> "\" Then Folder = Folder & "\" If Dir(Folder & searchF, vbDirectory) <> "" Then colFolder.Add Folder & searchF & "\" sf = Dir(Folder, vbDirectory) Do While Len(sf) > 0 If sf <> "." And sf <> ".." Then If (GetAttr(Folder & sf) And vbDirectory) <> 0 Then Debug.Print Folder & sf counter = counter + 1 subF.Add Folder & sf End If End If sf = Dir() Loop For Each SubFolder In subF GetFolder CStr(SubFolder), searchF, colFolder, counter Next End Sub Public Sub TestMe() Dim newC As New Collection Dim colChecked As New Collection Dim counter As Long GetFolder "C:\Users\<username>\Desktop\BA Tools", "v", newC, counter Debug.Print counter End Sub
What is the number that you get at the end of the code, when you run it?