Creating Worksheets based on Filenames

Hi All,

I am trying to create multiple sheets in a single workbook from the file names of all the files in a particular folder.

Example:

1) A folder has 4 .xlsx files and their names are: MyFile1, MyFile2, MyFile3, MyFile4
2) There's a workbook that has only its default sheet inside
3) The macro needs to scan the folder for all the files with .xlsx extension in this folder and store the file names in an array
4) In this example, there are only four files therefore the array should store 4 file names
5) Then the macro will create the four sheets and name each sheet according the file names found in the folder

I currently have the below code sample, which works but there's two issues:

1) It only creates ONE sheet and renames it with the first file's name - The loop is therefore not working here
2) It creates the sheets name with the file name AND the extension (MyFile1.xlsx etc)- I only require the file name, not the extension

Sub CreateNewWorkSheet()

    'Instantiate variables
    Dim xSht As Worksheet
    Dim xNSht As Worksheet
    Dim xSUpdate As Boolean
    Dim xRow As Long
    Dim MyFile As String
    Dim Counter As Long
        
    On Error Resume Next
    
    Set xSht = ActiveWorkbook.Sheets("3rd Party")
    
    'Create a dynamic array variable, and then declare its initial size
    Dim DirectoryListArray() As String
    ReDim DirectoryListArray(1000)

    'Loop through all the files in the directory by using Dir$ function
    MyFile = Dir$("C:\Users\Desktop\3rd Party\Work Folder\*.*")
    
    'This line of code just helps the macro sun faster
    xSUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False
    
    For Counter = 0 To UBound(DirectoryListArray)
    
        DirectoryListArray(Counter) = MyFile
    
        'If the sheet does not exist, then create the new sheet and name it the string from index I
        If xNSht Is Nothing Then
            Set xNSht = Worksheets.Add(, Sheets(Sheets.Count))
            xNSht.Name = DirectoryListArray(Counter)
        Else
            
        End If
        
        Counter = Counter + 1
    
    Next Counter

    'Reset the size of the array without losing its values by using Redim Preserve
    ReDim Preserve DirectoryListArray(Counter - 1)
    
    xSht.AutoFilterMode = False
    xSht.Activate
    Application.ScreenUpdating = xSUpdate
    
End Sub 

Open in new window

Eitel DagninIT Security AdministratorAsked:
Who is Participating?
 
NorieConnect With a Mentor VBA ExpertCommented:
Why do you need an array?
Sub test()
Dim strFilename As String, strPath As String

    strPath = "C:\Test\"
    strFilename = Dir(strPath & "\" & "*.xlsx")

    Do Until strFilename = ""
        Sheets.Add.Name = Split(strFilename, ".")(0)
        strFilename = Dir()
    Loop

End Sub

Open in new window

1
 
Omar SoudaniConnect With a Mentor System Support EngineerCommented:
0
 
Bill PrewCommented:
In which case, why post it here now???


»bp
0
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

 
Eitel DagninIT Security AdministratorAuthor Commented:
Hi All,

I post to multiple sites at the same time to receive a wider range of help.. As I work through the help I receive I go back to each site and update my posts. You'll notice with my past question that when i receive an answer I provide the answer to my questions and the link for where I got it.

Sometimes it takes a little longer for me to get around to the sites before a reply comes through.

Apologies for any inconvenience.
0
 
NorieVBA ExpertCommented:
Eitel

There's nothing wrong with that really but on each site you post you should inform that you are cross-posting and provide links when you create the original post(s), not when you get a solution.

If you don't do that it's possible people will spend time trying to help you only to find out that you received a solution elsewhere while they were working on the problem.

Some people might not look too kindly on that.:)
0
 
Eitel DagninIT Security AdministratorAuthor Commented:
Hi All,

I do apologize sincerely, it didn't occur to me to think of it the way Norie explained - I will for future posts advise with a link when I post a question on multiple forums.

@Norie - I appreciate your reply and the code you provided - it also works great!

I found the one answer here:

https://stackoverflow.com/questions/49509661/creating-worksheets-based-on-filenames

Code:

Sub test()
  Dim Filenames As Variant, strFilename As Variant, strPath As String
  Dim i As LongPtr

  strPath = "D:\myPath"
  strFilename = Dir(strPath & "\" & "*.xlsx")
  Do Until strFilename = ""
    Filenames = Filenames & "|" & strFilename
    strFilename = Dir
  Loop

  Filenames = Mid(Filenames, 2)
  Filenames = Split(Filenames, "|")  ' <- all .xlsx filenames in this array

  For i = LBound(Filenames) To UBound(Filenames)
    with Worksheets.Add 
      .name = Left(Filenames(i), Len(Filenames(i)) - 5)
    end with
  Next i

End Sub

Open in new window

And another reply on a different forum with "cleaner" code: (identical to Norie's code)

Link: http://www.tek-tips.com/viewthread.cfm?qid=1785646

Code:

Option Explicit

Sub test()
Dim strFilename As String
Dim strPath As String

strPath = "D:\myPath\"
strFilename = Dir(strPath & "*.xlsx")
Do Until strFilename = ""
    strFilename = Split(strFilename, ".")(0)
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = strFilename
    strFilename = Dir
Loop

End Sub 

Open in new window


All of them work great.

Apologies for any inconvenience.
0
 
Eitel DagninIT Security AdministratorAuthor Commented:
There are two issues I require assistance with still on the same subject - Error Handling.

1) If the sheet name already exists

2) To exclude certain files in the directory by file name - This isn't such a huge issue, but if it can be done that would be really great

Here is some code for the first problem - but I don't know how to implement it as the parameters are a string:

Function sheetExists(sheetToFind As String) As Boolean
    sheetExists = False
    For Each Sheet In Worksheets
        If sheetToFind = Sheet.Name Then
            sheetExists = True
            Exit Function
        End If
    Next Sheet
End Function

Open in new window


Here is some code for the second problem:

For i = LBound(Filenames) To UBound(Filenames)

        Do While Filenames <> "test.xlsx"

            With x.Worksheets.Add
            .Name = Left(Filenames(i), Len(Filenames(i)) - 5)
        Loop

    End With

    Next i

Open in new window


With either the Do While or If Else Statement, I keep getting the error:

Loop without Do While
or
End If without Block If
or
Else Without If

I have asked for help on this same topic at the below two links:

http://www.tek-tips.com/viewthread.cfm?qid=1785646
https://stackoverflow.com/questions/49509661/creating-worksheets-based-on-filenames
0
 
Omar SoudaniSystem Support EngineerCommented:
Since this question already tagged as solved, some experts will not look into it, I suggest you post a new one addressing the issue.
0
 
Eitel DagninIT Security AdministratorAuthor Commented:
Thank you Omar, I will do so now. :)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.