Align new weeks on same row

[geertech]

I have the following code to get a filelist from sub-folders like KW03, KW04, etc.
The list generates nicely, but I would like any following week to start on the same row for each client (so, if client 1 has 10 quotes and client 2 just 5 in say, KW03, I want KW04 to start on row 12 (with one blank cell underneath the last file in KW03) for all clients. So have blank rows for the client that just has 5 quotes rather than the 10 for client 2.
I can't seem to get it to work properly, does anybody have an idea how to get this workin?

Here's the code, and capture of my result s far

Sub UpdateFileListWithWeeks()
    Dim ws As Worksheet
    Dim mainFolder As String
    Dim fso As Object
    Dim folder As Object
    Dim customerFolder As Object
    Dim customerName As String
    Dim weekFolder As Object
    Dim weekName As String
    Dim weekFiles As Object
    Dim customerData As Object
    Dim currentRow As Long
    Dim currentColumn As Long
    Dim maxWeekRow As Long

    ' Setup the main folder from the active workbook path
    mainFolder = ActiveWorkbook.Path
    If mainFolder = "" Then
        MsgBox "Please save the workbook first!", vbExclamation
        Exit Sub
    End If

    ' Create the "Bestandenlijst" sheet if it doesn't exist
    On Error Resume Next
    Set ws = ActiveWorkbook.Sheets("Bestandenlijst")
    On Error GoTo 0

    If ws Is Nothing Then
        Set ws = ActiveWorkbook.Sheets.Add
        ws.Name = "Bestandenlijst"
    Else
        ws.Cells.Clear
    End If

    ' Initialize the first row
    ws.Cells(1, 1).Value = "Bestandenlijst"
    ws.Cells(1, 1).Font.Bold = True
    ws.Cells(1, 1).Font.Size = 14
    ws.Rows(1).RowHeight = 20

    currentColumn = 1 ' Start in column 1 (A)
    currentRow = 3 ' Start at row 3 for the first customer

    ' FileSystemObject to manage folder structure
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(mainFolder)

    ' Process each customer
    For Each customerFolder In folder.Subfolders
        ' Skip excluded folders
        If Not IsExcludedFolder(customerFolder.Name) Then
            customerName = customerFolder.Name
            ws.Cells(currentRow, currentColumn).Value = customerName
            ws.Cells(currentRow, currentColumn).Font.Bold = True

            ' Process weeks (KW03, KW04, etc.)
            currentRow = currentRow + 1
            ProcessWeeks customerFolder, ws, currentColumn, currentRow

            ' Move to the next column for the next customer
            currentColumn = currentColumn + 1
            currentRow = 3 ' Reset row for next customer
        End If
    Next customerFolder

    ' Autofit columns
    ws.Columns.AutoFit

    MsgBox "Bestandenlijst is bijgewerkt!", vbInformation
End Sub

Sub ProcessWeeks(customerFolder As Object, ws As Worksheet, currentColumn As Long, ByRef currentRow As Long)
    Dim weekFolder As Object
    Dim weekName As String
    Dim weekFiles As Object
    Dim file As Object
    Dim weekRow As Long

    weekRow = currentRow ' Set the starting row for weeks

    ' Process each week in the customer's folder
    For Each weekFolder In customerFolder.Subfolders
        ' Only process folders starting with "KW"
        If UCase(Left(weekFolder.Name, 2)) = "KW" Then
            weekName = weekFolder.Name
            ws.Cells(weekRow, currentColumn).Value = weekName ' Set week name in the column header
            ws.Cells(weekRow, currentColumn).Font.Bold = True
            weekRow = weekRow + 1

            ' Add files from this week
            Set weekFiles = weekFolder.files
            For Each file In weekFiles
                ws.Cells(weekRow, currentColumn).Value = file.Name
                weekRow = weekRow + 1
            Next file
        End If
    Next weekFolder

    ' Update the row for the next customer after processing all weeks
    currentRow = weekRow + 1
End Sub

Function IsExcludedFolder(folderName As String) As Boolean
    Dim excludedFolders As Variant
    excludedFolders = Array("zMacro's", "zPics") ' Define folders to exclude
    IsExcludedFolder = False

    For i = LBound(excludedFolders) To UBound(excludedFolders)
        If UCase(folderName) = UCase(excludedFolders(i)) Then
            IsExcludedFolder = True
            Exit Function
        End If
    Next i
End Function

Thanks so much in advance,
Remo

 

[Peter_SSs]

When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block at the bottom of this post has more details. I have added the tags for you this time.

 

[geertech]

When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block at the bottom of this post has more details. I have added the tags for you this time.

Sorry, it's been a whie since I posted, will do so next time It!
Thanks so much for updating!