Generate a list of the last 100 modified folders This is a subroutine I have written as a part of an Excel VBA script. I usually write vb.net or Python but I need the final results for this project in Excel so I'm using VBA.

My initial task is to get the latest 5-100 folders by date last modified (user selects the number of folders). Looking at this question on SO, I found out how to get a list of folders and store it in the cells in excel with the date last modified. This can then be sorted by date modified and I can then work my way down the list for however many folders the user selected.

The code puts this list into a new sheet called Folders, clearing out any old versions if needed.

I can't help but feel that storing the list in cells isn't the best way to do it. I would have thought it would be better to have it in some sort of dictionary or list but I could be mistaken.

Currently, there are around 1000 subfolders in the directory to search and this could potentially grow over 10,000 in the future. Will this approach still work well with that many folders?  

Are there any other general improvements I could make?

Sub Get_Sorted_Folder_List(results_dir As String)

    ' Var Declarations
    Dim fso As New FileSystemObject
    Dim fs_folder As Folder
    Dim folder_sheet As Worksheet

    ' Setup "Folders" worksheet
    ' Detect if it already exists, delete if it does
    Application.DisplayAlerts = False
    Err.Clear
    On Error Resume Next
    Set folder_sheet = Sheets("Folders")
    If Err = 0 Then folder_sheet.Delete
    On Error GoTo 0

    ' Create new Folders sheet
    Set folder_sheet = ThisWorkbook.Sheets.Add(After:= _
                            ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    folder_sheet.Name = "Folders"
    folder_sheet.Select
    Range("A1").Select
    Columns(1).ColumnWidth = 10
    Columns(2).ColumnWidth = 18

    ' Get list of files
    Set fs_folder = fso.GetFolder(results_dir)
    Dim counter As Integer
    counter = 0

    For Each Folder In fs_folder.SubFolders
        counter = counter + 1
        Cells(counter, 1).Value = Folder.Name
        Cells(counter, 2).Value = Folder.DateLastModified
    Next

    ' Sort newest to oldest
    folder_sheet.Sort.SortFields.Clear
    folder_sheet.Sort.SortFields.Add Key:= _
        Range(Cells(1, 2), Cells(counter, 2)), SortOn:=xlSortOnValues, _
        Order:=xlDescending, DataOption:=xlSortNormal

    With folder_sheet.Sort
        .SetRange Range(Cells(1, 1), Cells(counter, 2))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub
A couple of general things (in addition to what Vogel said about using explicit references):


Consider avoiding the "On Error" statements and using a short/reusable "sheetExists" function instead. Something like this:

Function sheetExists(wb As Workbook, wsName As String) As Boolean
    Dim tempBool As Boolean
    tempBool = False
    Dim ws As Worksheet
    For Each ws In wb.Sheets
        If ws.Name = wsName Then
            tempBool = True
            Exit For
        End If
    Next
    sheetExists = tempBool
End Function

Avoid select statements, which slow down your code and make it less readable. For example:

'This section...
folder_sheet.Select
Range("A1").Select
Columns(1).ColumnWidth = 10
Columns(2).ColumnWidth = 18
'...could be rewritten as:
With folder_sheet
    .Columns(1).ColumnWidth = 10
    .Columns(2).ColumnWidth = 18
End With

Read the folder information into an array and write it to the workbook all at once, instead of writing one value at a time. This will greatly improve performance, especially once you start getting into the thousands of folders.

'Old version
Set fs_folder = fso.GetFolder(results_dir)
Dim counter As Integer
counter = 0

For Each Folder In fs_folder.SubFolders
    counter = counter + 1
    Cells(counter, 1).Value = Folder.Name
    Cells(counter, 2).Value = Folder.DateLastModified
Next

'New version
Set fs_folder = fso.GetFolder(results_dir)
ReDim subFolderArr(1 To fs_folder.SubFolders.Count, 1 To 2) As Variant

Dim counter As Long
counter = 0
For Each Folder In fs_folder.SubFolders
    counter = counter + 1
    subFolderArr(counter, 1) = Folder.Name
    subFolderArr(counter, 2) = Folder.DateLastModified
Next

With folder_sheet
    .Range(.Cells(1, 1),.Cells(counter, 2)) = subFolderArr
End With



Overall, here's what the finished product would look like (it took 36.5 seconds to complete in a directory with 100k test subfolders):

Sub Create_Sorted_Folder_List(results_dir As String)

    'Create/clear data from results sheet
    Dim folder_sheet As Worksheet
    If sheetExists(ThisWorkbook, "Folders") Then
        Set folder_sheet = ThisWorkbook.Sheets("Folders")
        folder_sheet.Cells.Clear
    Else
        Set folder_sheet = ThisWorkbook.Worksheets.Add
        folder_sheet.Name = "Folders"
    End If

    'Get subfolder list, add data to sheet, and create table
    Dim fileArr As Variant
    fileArr = getSubfolderList(results_dir)

    With folder_sheet
        .Range("A1") = "File Name"
        .Range("B1") = "Date Modified"
        .Range(.Cells(2, 1), .Cells(UBound(fileArr, 1) + 1, 2)) = fileArr
        .ListObjects.Add(xlSrcRange, .Range(.Cells(1, 1), _
                                            .Cells(UBound(fileArr, 1) + 1, 2)), , xlYes).Name = "ResultsTable"
    End With

    Dim resultsTbl As ListObject
    Set resultsTbl = folder_sheet.ListObjects("ResultsTable")

    'Sort and format table
    With resultsTbl
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.ListColumns("Date Modified").Range, _
                        SortOn:=xlSortOnValues, _
                        Order:=xlDescending, _
                        DataOption:=xlSortNormal
        .Sort.Apply
        'Set column widths manually...
        .ListColumns("File Name").Range.ColumnWidth = 10
        .ListColumns("Date Modified").Range.ColumnWidth = 18
        '...or just autofit instead
        '.Range.Columns.Autofit
    End With

End Sub
Function getSubfolderList(sourcePath As String) As Variant
'Creates array of subfolders in the first level of a directory (sourcePath)
'Stores name/date modified of each subfolder

    Dim fso As Object
    Set fso = CreateObject("Scripting.Filesystemobject")

    ReDim subfolderArr(1 To fso.GetFolder(sourcePath).Subfolders.Count, 1 To 2) As Variant
    Dim i As Long
    i = 0
    Dim subF As Object
    For Each subF In fso.GetFolder(sourcePath).Subfolders
        i = i + 1
        subfolderArr(i, 1) = subF.Name
        subfolderArr(i, 2) = subF.DateLastModified
    Next

    getSubfolderList = subfolderArr

End Function
Function sheetExists(wb As Workbook, wsName As String) As Boolean
'Determines whether a sheet with a given name (wsName) exists in a workbook (wb)

    Dim ws As Worksheet
    Dim tempBool As Boolean
    tempBool = False
    For Each ws In wb.Sheets
        If ws.Name = wsName Then
            tempBool = True
            Exit For
        End If
    Next
    sheetExists = tempBool

End Function