count files extensions files for each month based on modified date

[Aussiebear]

Maybe this might do what you want?

Sub CountFileExtensionsByMonth()
    Dim fso As Object, folder As Object, subFolder As Object, file As Object
    Dim wb As Workbook, ws As Worksheet, newWs As Worksheet
    Dim dict As Object, ext As String, monthYear As String
    Dim rowNum As Long
    Dim FolderPath As String
    ' Initialize FileSystemObject and Dictionary
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set dict = CreateObject("Scripting.Dictionary")
    Set wb = ThisWorkbook ' This workbook
    ' Prompt the user for the folder path
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select the folder to process"
        .AllowMultiSelect = False
        If .Show = True Then
            FolderPath = .SelectedItems(1)
        Else
            MsgBox "Folder selection cancelled.", vbCritical
            Exit Sub
        End If
    End With
    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
    ' Create a new worksheet for the results
    Set newWs = wb.Sheets.Add
    newWs.Name = "File Extension Counts"
    ' Add headers to the worksheet
    newWs.Cells(1, 1).Value = "Month/Year"
    newWs.Cells(1, 2).Value = "Extension"
    newWs.Cells(1, 3).Value = "Count"
    rowNum = 2 ' Start writing data from row 2
    ' Recursive function to process folders and subfolders
    Sub ProcessFolder(ByRef folderPath As String)
        Dim currentFolder As Object, currentFile As Object, subFolderObj As Object
        Set currentFolder = fso.GetFolder(folderPath)
        ' Loop through each file in the current folder
        For Each currentFile In currentFolder.Files
            ext = LCase(fso.GetExtensionName(currentFile.Path)) ' Get and lowercase the extension
            monthYear = Format(currentFile.DateLastModified, "YYYY-MM") ' Get month and year
            If ext <> "" Then 'avoid counting files with no extension.
                If Not dict.exists(monthYear & "|" & ext) Then
                    dict.Add monthYear & "|" & ext, 1
                Else
                    dict(monthYear & "|" & ext) = dict(monthYear & "|" & ext) + 1
                End If
            End If
        Next currentFile
        ' Recursively process subfolders
        For Each subFolderObj In currentFolder.SubFolders
            ProcessFolder subFolderObj.Path
        Next subFolderObj
    End Sub
End Sub