Thread: How to create multiple directories from cells using a macro or VBA

I have a very long list of numbers that I want to create directories for in a main shared network drive. I have found multiple HELP threads on the topic of how to create one directory and have made that work, but somehow need to be able to progress through the rows of cells in order to create multiple directories, in order to avoid having to create these directories manually. The VBA code I copied from a previous thread is as follows:

Private Sub CommandButton1_Click()
    Dim sDir As String
    
    sDir = Range("B3").Text
    
    If Len(Dir(sDir, vbDirectory)) Then
        MsgBox ("Directory already exists")
    Else
        MsgBox IIf(MakeDir(sDir), "Directory created", "Failed")
    End If
End Sub

Function MakeDir(ByVal sDir As String) As Boolean
    ' shg 2008
    ' Returns True if the directory sDir exists or is successfully created

    Static sPS  As String
    Dim astr()  As String
    Dim iLvl    As Long

    If Len(Dir(sDir, vbDirectory)) = 0 Then
        If Len(sPS) = 0 Then sPS = Application.PathSeparator

        If Right(sDir, 1) = sPS Then sDir = Left(sDir, Len(sDir) - 1)
        astr = Split(sDir, sPS)

        ' MkDir will fail if sDir contains characters 0-31
        ' or any of the characters ' < > : " / \ | ? *
        ' or if the drive does not exist
        
        sDir = ""
        On Error Resume Next
        For iLvl = 0 To UBound(astr)
            sDir = sDir & astr(iLvl) & sPS
            If Len(Dir(sDir, vbDirectory)) = 0 Then MkDir sDir
            If Err.Number <> 0 Then
                Err.Clear
                Exit Function   '---------------------------------------------->
            End If
        Next iLvl
    End If
    
    MakeDir = True
End Function

As mentioned, this works to create one directory, but, as per the attached sample worksheet, I need to be able to progress down the rows of cells from B3 to B4, etc.

Any help/suggestions or appropriate code would be very much appreciated.

Welcome to the forum, riskmgr! Modified sub:

Private Sub CommandButton1_Click()
    Dim sDir As String, lngLastRow As Long
    
    lngLastRow = Range("B65536").End(xlUp).Row
    
    'iterate through range
        For Each c In Range("B3:B" & lngLastRow)
            sDir = Range("B" & c.Row).Text
            If Len(Dir(sDir, vbDirectory)) Then
                MsgBox ("Directory already exists")
            Else
                MsgBox IIf(MakeDir(sDir), "Directory created", "Failed")
            End If
        Next
End Sub

See attached book for testing.