Creation and modification dates mean two different things. I only coded for creation date but it is easily changed to modification date. Be aware though that you should probably delete the data range each time if you use modification dates as it will list a file in more than one column, unless you want that.
1. Put code below in a Module in your xlsm file with the worksheets setup.
2. Change the value pf to be your parent folder's path.
3. Set the fso reference as commented.
4. Run Main().
Sub Main()
Dim pf As String, sfs, sfp
'Tools > References > Microsoft Scripting Runtime
Dim fso As FileSystemObject, sf As Scripting.Folder, f As Scripting.File
Dim ws As Worksheet, fr As Range
Dim mn As String, fbn As String
'Parent Folder
pf = "d:\myfiles\t"
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Set fso = New FileSystemObject
'Array with Subfolder paths.
'http://www.vbaexpress.com/forum/showthread.php?58579-get-file-paths-based-on-name-criteria-from-folder
sfs = aFFs(pf, "/ad", True)
'No error check for subfolder paths put into sfs. At least one subfolder is assumed.
For Each sfp In sfs
Set sf = fso.GetFolder(sfp)
'Set worksheet for input: Assumes that each subfolder name has a worksheet name.
Set ws = Worksheets(sf.ShortName) 'e.g. CSV, XLS, XLSM, etc.
For Each f In sf.Files
'Month number from file's date created.
mn = Month(f.DateCreated)
'File's basename
fbn = fso.GetBaseName(f.Name)
'Find fbn in month name's column
Set fr = ws.Columns(mn + 1).Find(fbn)
If fr Is Nothing Then
ws.Cells(ws.Rows.Count, mn + 1).End(xlUp).Offset(1) = fbn
End If
Next f
ws.UsedRange.Columns.AutoFit
Next sfp
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
'Set extraSwitches, e.g. "/ad", to search folders only.
'MyDir should end in a "\" character unless searching by wildcards, e.g. "x:\test\t*
'Command line switches for the shell's Dir, http://ss64.com/nt/dir.html
Function aFFs(myDir As String, Optional extraSwitches = "", _
Optional tfSubFolders As Boolean = False) As Variant
Dim s As String, p As String, a() As String, v As Variant
Dim b() As Variant, i As Long, fso As Object
If tfSubFolders Then
s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
"""" & myDir & """" & " /b /s " & extraSwitches).StdOut.ReadAll
Else
Set fso = CreateObject("Scripting.FileSystemObject")
p = fso.GetParentFolderName(myDir) & "\"
s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
"""" & myDir & """" & " /b " & extraSwitches).StdOut.ReadAll
End If
a() = Split(s, vbCrLf)
If UBound(a) = -1 Then
MsgBox myDir & " not found.", vbCritical, "Macro Ending"
Exit Function
End If
ReDim Preserve a(0 To UBound(a) - 1) As String 'Trim trailing vblfcr
For i = 0 To UBound(a)
If Not tfSubFolders Then
'add the folder name
a(i) = p & a(i)
End If
Next i
Set fso = Nothing
aFFs = sA1dtovA1d(a)
End Function
Function sA1dtovA1d(strArray() As String) As Variant
Dim varArray() As Variant, i As Long
ReDim varArray(LBound(strArray) To UBound(strArray))
For i = LBound(strArray) To UBound(strArray)
varArray(i) = CVar(strArray(i))
Next i
sA1dtovA1d = varArray()
End Function