跨列的VBA循环宏

Question

Good Afternoon,

I have a worksheet that runs multiple macros.

module #1 lists the sub folders of a master directory across columns on row 3. (Works Correctly)

module #2 lists a specific sub folder from the resulting folder from module #1 based on keywords, the result is printed to row 4. This module functions correctly for column A, though I have been unsuccesful in repeating the calculation across the columns based on a reletive cell reference across row 3. What the code is doing is returning the correct result to A4, and then prints the same result to B4,C4... i cant seem to modify this code to consider the row 3 result for each column.

Private Sub PrintFolders()
Dim objFSO As Object
Dim OBJFolder As Object
Dim objSubFolder As Object
Dim i As Integer

    Dim rCell As Range
    Dim rRng As Range

    Set rRng = Sheet1.Range("A4:BZ4")

    For Each rCell In rRng.Cells
Application.StatusBar = ""
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set OBJFolder = objFSO.getfolder(Sheets("Sheet1").Range("A3").Value)
i = i + 1

'loops through each folder in the directory and prints their names and path
On Error GoTo handleCancel

For Each objSubFolder In OBJFolder.SubFolders
If InStr(1, objSubFolder.Name, "Plans", vbTextCompare) > 0 Or InStr(1, objSubFolder.Name, "Sketches", vbTextCompare) > 0 Then
Application.StatusBar = objSubFolder.Path & " " & objSubFolder.Name
    'print folder path
    Cells(1 + 3, i) = objSubFolder.Path
    i = i

Else
End If

Next objSubFolder
Next rCell
handleCancel:
If Err = 18 Then
 MsgBox "You cancelled"
End If

End Sub

any assistance is very appreciated.

Answer 1

I have not tried this, but I think using the Offset function will give you the cell relative to the current cell you are calculating from.

Private Sub PrintFolders()
    Dim objFSO As Object
    Dim OBJFolder As Object
    Dim objSubFolder As Object
    Dim i As Integer

        Dim rCell As Range
        Dim rRng As Range

        Set rRng = Sheet1.Range("A4:BZ4")

        For Each rCell In rRng.Cells
    Application.StatusBar = ""
    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Get the folder object
    Set OBJFolder = objFSO.getfolder(rCell.Offset(-1, 0).Value)
    i = i + 1

    'loops through each folder in the directory and prints their names and path
    On Error GoTo handleCancel

    For Each objSubFolder In OBJFolder.SubFolders
    If InStr(1, objSubFolder.Name, "Plans", vbTextCompare) > 0 Or InStr(1, objSubFolder.Name, "Sketches", vbTextCompare) > 0 Then
    Application.StatusBar = objSubFolder.Path & " " & objSubFolder.Name
        'print folder path
        Cells(1 + 3, i) = objSubFolder.Path
        i = i
    Else

    End If

    Next objSubFolder
    Next rCell
    handleCancel:
    If Err = 18 Then
     MsgBox "You cancelled"
    End If

    End Sub