1

I am using this code to create folders based on names mentioned in Column A, however at times this does not create folders and at times it does not create all the folders. I could not figure out the issue or if anything is missing in it.

I will really appreciate if any amendment could be made where if a particular folder is already available (based on cell value) it does not show error.

Sub MakeFolders()
  Dim Rng As Range
  Dim maxRows, maxCols, r, c As Integer
  Set Rng = Selection

  maxRows = Rng.Rows.Count
  maxCols = Rng.Columns.Count

  For c = 1 To maxCols
    r = 1
    Do While r <= maxRows
      If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, c), vbDirectory)) = 0 Then
        MkDir (ActiveWorkbook.Path & "\" & Rng(r, c))
        On Error Resume Next
      End If
      r = r + 1
    Loop
  Next c
End Sub
braX
  • 11,506
  • 5
  • 20
  • 33
Salman Shafi
  • 249
  • 9
  • 4
    You firstly need to comment `On Error Resume Next`. It does not bring any benefit, **only does not let you know what error your code raises**... A better approach would be to place all the range in an array then iterate between its rows/columns, chekhing **if there are not empty cells** or **illegal characters**. – FaneDuru Nov 24 '22 at 12:09
  • Should i remove this line "On Error Resume Next" – Salman Shafi Nov 24 '22 at 12:17
  • Yes, does not help at all, on contrarious, it does not let you know what problems may be with the string used to make a folder (name)... – FaneDuru Nov 24 '22 at 12:18
  • It still just reads 1 cell i.e. A1 for creating folder, not reading rest of cells – Salman Shafi Nov 24 '22 at 12:36
  • Your code iterates **inside a selection**. Did you select more than a single cell? – FaneDuru Nov 24 '22 at 12:41
  • I have not selected any cell. In Column A i have added the Folders name which for now is from A1 to A11 – Salman Shafi Nov 24 '22 at 12:44
  • Do you understand what `Set Rng = Selection` does mean? Then, do you understand what `Rng(r, c)` does mean, too? I think it would be better to clearly explain, **in words** what you try accomplishing... Do you want iterating between **all the used range cells**? – FaneDuru Nov 24 '22 at 12:52
  • Yes, the goal is whatever the values given in Column A till last cell the code should create folder based on those values, – Salman Shafi Nov 24 '22 at 13:03
  • Only in A:A column? Then, no sense to iterate **by columns**... I will prepare a piece of code, running faster and also checking against illegal characters... – FaneDuru Nov 24 '22 at 13:05
  • Yes only in Column A. please do include that if the folder already exist the code should skip that cell and move to next cell till last cell, there will be more than 500 folders which needs to be created – Salman Shafi Nov 24 '22 at 13:06

2 Answers2

0

Please, try the next adapted code. It uses an array, all iteration being done in memory (much faster than iterating between cells) and checks if a cell is empty or contains illegal characters, not accepted in a path:

Sub MakeFolders()
  Dim sh As Worksheet, lastR As Long, arr, i As Long, rootPath As String
  
  Set sh = ActiveSheet
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
  
   arr = sh.Range("A2:A" & lastR).Value2

  rootPath = ThisWorkbook.Path & "\"
  For i = 1 To UBound(arr)
        If arr(i, 1) <> "" And noIllegalChars(CStr(arr(i, 1))) Then
                If Dir(rootPath & arr(i, 1), vbDirectory) = "" Then
                    MkDir rootPath & arr(i, 1)
                End If
        Else
                MsgBox "Illegals characters or empty cell (" & sh.Range("A" & i + 1).address & ")..."
        End If
  Next i
End Sub

Function noIllegalChars(x As String) As Boolean
   Const illCh As String = "*[\/\\"":\*?]*"
   If Not x Like illCh Then noIllegalChars = True
End Function

It iterates between (existing) cells in column A:A and check if they are empty, do not contain illegal characters or the folder has already been created.

FaneDuru
  • 38,298
  • 4
  • 19
  • 27
  • Dear @FaneDuru based on this code, tomorrow i will post another question which is bit complicated i.e. after creating the folders via the code you have provided it requires to move the files in these folders which are created based on file names mentioned in excel sheet using partial list method, i will explain in detail tomorrow as well – Salman Shafi Nov 24 '22 at 13:30
  • Affirmative i will try to update a clear question. Thanks – Salman Shafi Nov 24 '22 at 13:35
  • Please, is using `FileSystemObject (FSO)` or `Mkdir` is faster ? – Waleed Nov 25 '22 at 08:30
  • 1
    @Waleed Both work with comparable speed. Now, using one or another depends on what you try doing **besides folder creation**. If only need checking if the folder exists and create a new one, `mkDir` is good enough. If besides that you need changing, copying, deleting, Attributes change, extension extract, creation/last modification time etc. use `If Not fso.FolderExists(NewFolderPath) Then fso.CreateFolder NewFolderPath`. If speed is the main issue, use Early Binding. Create a reference to `Microsoft Scripting Runtime`. And declare `Dim fso As FileSystemObject`. – FaneDuru Nov 25 '22 at 09:04
  • @Salman Shafi If you place a new question and need me to help, please tag me here, with its link. If I will be available I will try helping. Otherwise, I am rather busy and not looking to the new questions... – FaneDuru Nov 25 '22 at 12:52
  • Dear @FaneDuru i have posted a question which you can find https://stackoverflow.com/questions/74568885/to-copy-files-with-similar-name-into-folders?noredirect=1#comment131634470_74568885 – Salman Shafi Nov 25 '22 at 12:54
0

Create Folders From Range Selection

  • This solution creates folders simply if it is possible i.e. based on On Error Resume Next making it kind of a hack.
  • To 'make amends' on the hack part, it returns a table, containing some stats about the folders that could not be created, in the Immediate window (Ctrl+G).
  • If you're not interested at all in why a folder was not created, remove the Debug Print routine i.e. the lines ending in ' DP.
Option Explicit

Sub CreateFoldersFromSelection()
   
    If Selection Is Nothing Then Exit Sub
    If Not TypeOf Selection Is Range Then Exit Sub
    
    ' Set the workbook...
    Dim wb As Workbook: Set wb = Selection.Worksheet.Parent
    ' ... to build the path.
    Dim fPath As String: fPath = wb.Path & Application.PathSeparator
    
    Dim arg As Range, Data() As Variant
    Dim r As Long, c As Long, rCount As Long, cCount As Long
    Dim ErrNum As Long, ErrDescription As String ' DP
    
    Debug.Print "Folders in '" & fPath & "' not created:" ' DP
    Debug.Print "Name", "Cell Address", "Error Number", "Error Description" ' DP
    
    ' Loop over each area of the selection...
    For Each arg In Selection.Areas
        ' ... to return the area's values in an array, ...
        rCount = arg.Rows.Count
        cCount = arg.Columns.Count
        If rCount * cCount = 1 Then
            ReDim Data(1 To 1, 1 To 1): Data(1, 1) = arg.Value
        Else
            Data = arg.Value
        End If
        ' ... then loop over the values in the array...
        For r = 1 To rCount
            For c = 1 To cCount
                ' ... to attempt to create the current folder.
                On Error Resume Next
                    MkDir fPath & Data(r, c)
                    ErrNum = Err.Number ' DP
                    ErrDescription = Split(Err.Description, vbLf)(0) & "..." ' DP
                On Error GoTo 0
                If ErrNum <> 0 Then ' DP
                    ' Print a line of stats about the folder not created.
                    Debug.Print Data(r, c), arg.Cells(r, c).Address(0, 0), _
                        ErrNum, ErrDescription ' DP
                End If ' DP
            Next c
        Next r
    Next arg

    MsgBox "Folders created.", vbInformation
    
End Sub
VBasic2008
  • 44,888
  • 5
  • 17
  • 28