Create folders based on column range

[jmazorra]

Hello folks:

I created a script to create a folder based on a cell value. However, I actually needed to create folders based on the values of column F. How do I create a loop to do that?

Any help will be appreciated.

Sub CreateFolder()
Dim NewFolder As String
    NewFolder = "C:\2022 STI Folder\PDF\" & Range("F2")
        If Len(Dir(NewFolder, vbDirectory)) = 0 Then
           MkDir NewFolder
        Else
            MsgBox "Folder already exists"
        End If
End Sub

 

[Joe4]

Try this:

Sub CreateFolder()

Dim lr As Long
Dim r As Long
Dim NewFolder As String

'   Find last row in column F with data
    lr = Cells(Rows.Count, "F").End(xlUp).Row
    
'   Loop through all rows starting on row 2
    For r = 2 To lr
        NewFolder = "C:\2022 STI Folder\PDF\" & Range("F" & r)
        If Len(Dir(NewFolder, vbDirectory)) = 0 Then
           MkDir NewFolder
        Else
            MsgBox "Folder already exists"
        End If
    Next r
    
End Sub

 

[jmazorra]

Try this:

Sub CreateFolder()

Dim lr As Long
Dim r As Long
Dim NewFolder As String

'   Find last row in column F with data
    lr = Cells(Rows.Count, "F").End(xlUp).Row
   
'   Loop through all rows starting on row 2
    For r = 2 To lr
        NewFolder = "C:\2022 STI Folder\PDF\" & Range("F" & r)
        If Len(Dir(NewFolder, vbDirectory)) = 0 Then
           MkDir NewFolder
        Else
            MsgBox "Folder already exists"
        End If
    Next r
   
End Sub

quick question, what can I do if instead of the msgbox I want the script to ignore the already created folder and move to the creating the next folder?

 

[Joe4]

Just remove the "Else" clause altogether, i.e.

Sub CreateFolder()

Dim lr As Long
Dim r As Long
Dim NewFolder As String

'   Find last row in column F with data
    lr = Cells(Rows.Count, "F").End(xlUp).Row
   
'   Loop through all rows starting on row 2
    For r = 2 To lr
        NewFolder = "C:\2022 STI Folder\PDF\" & Range("F" & r)
        If Len(Dir(NewFolder, vbDirectory)) = 0 Then
           MkDir NewFolder
        End If
    Next r
   
End Sub

 

[jmazorra]

Sub CreateFolder() Dim lr As Long Dim r As Long Dim NewFolder As String ' Find last row in column F with data lr = Cells(Rows.Count, "F").End(xlUp).Row ' Loop through all rows starting on row 2 For r = 2 To lr NewFolder = "C:\2022 STI Folder\PDF\" & Range("F" & r) If Len(Dir(NewFolder, vbDirectory)) = 0 Then MkDir NewFolder End If Next r End Sub

Thank you, exactly what I needed

 

[Joe4]

You are welcome.
Glad I was able to help!