Creating Worksheets based on Filenames

[Eitel13]

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

 

[Eitel13]

Hi All,

I got the solution. Here is the link:

https://stackoverflow.com/questions...rksheets-based-on-filenames/49510500#49510500

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

 

[Andrzejek]

Too convoluted, in my opinion.

Try this:

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

---- Andy

There is a great need for a sarcasm font.

 

[Eitel13]

Thank you Andy! This works brilliantly!

 

[Eitel13]

I received the below code for the same solution with some error handling included:

Link:

https://stackoverflow.com/questions...-sheets-based-on-file-names/49514537#49514537

Option Explicit

Sub test()

Dim strFilename As String
Dim strPath As String
Dim WB As Workbook

Set WB = ThisWorkbook ' define which workbook you want to add the sheets
strPath = "D:\myPath\"
strFilename = Dir(strPath & "*.xlsx")

Do Until strFilename = ""
    strFilename = Split(strFilename, ".")(0)

    ' check is strFilename already exists in existing sheets

    If sheetExists(strFilename) = False Then ' doesn't exist
        WB.Sheets.Add(After:=WB.Sheets(WB.Sheets.Count)).Name = strFilename
    Else
        ' just raise a message box
        MsgBox "Worksheet " & strFilename & " already exists.", vbInformation
    End If
    strFilename = Dir
Loop

End Sub

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

 

[Andrzejek]

You may also want to include a check for the length of the name of the sheet (based on file name).
File names may be long, but Excel puts a limit of the Sheet name - I think up to 31 characters.


---- Andy

There is a great need for a sarcasm font.

 

[SkipVought]

If this workbook that you are adding sheets to, is the workbook TWO in your other thread, Match Lookup and Copy Column, then why are you doing this needless step?

Simply copy the data from each workbook in the folder into the NEW table in workbook ONE, adding the appropriate wbk name in the wbk number column.

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[Eitel13]

Hi Skip,

Sorry for the long wait on the reply. Yes this is for related to what I required on the other thread. It just feels like this "project" is never ending and I am trying to explore many avenues that will help me achieve the end goal.

I would love to just import the workbooks, as you suggested, into the "second" sheet of the main workbook, however I have to change the "structure" of each workbook before the import will work correctly.

The issue is, each one of these 10 workbook are extracts that come from 10 different monitoring tools. In my other thread, I make mention of only 2 columns (EmpNum and Status), however, some workbooks have 7 columns, some have 4, some have 15 and so on.. So the idea was to import each workbook into a single workbook with multiple sheets, then manipulate the data in each sheet to fit the requirements for the lookup on the other thread... I hope this made sense...

As always, I am welcome to any suggestions and I do apologize for all the up and down replying.

 

[SkipVought]

however I have to change the "structure" of each workbook/worksheet/table before the import will work correctly.

If I understand you correctly, this could be accomplished via Data > Get External Data > From Other Sources > From Microsoft Query > Excel Files*... and drill down to the workbook/worksheet/table (a ONE TIME setup task) that can be manipulated in your code. In the query, you can select the columns/fields you need in the order that you desire.

Beyond that, you also stated...

So the idea was to import each workbook into a single workbook with multiple sheets, then manipulate the data in each sheet to fit the requirements for the lookup on the other thread... I hope this made sense...

Well, the devil is in the details, isn't it? So not knowing the various data from your 10 sheets, what it means and how they relate, no other suggestion is possible. It may simply be, that you need 10 different lookups in your summary table on sheet ONE. That would work.


Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[Eitel13]

Hi Skip,

I know it has been a while since a reply on this thread, however, I have come back with some answers..

In my other thread, I posted the question as though I already had a Workbook 2 with the 10 different sheets in them, as I thought the task of getting multiple workbooks into a single one was going to be an easy task and therefore I was simply trying to skip ahead to the part where I do the vlookup.

So, in actual fact, this is where and/how I create the second workbook I make reference to in the other thread.

There is a folder with excel files in them - sometimes it will be 5 files, sometimes 10, sometimes 12.. So what I was trying to do was actually really stupid and over complicated..

What I have is a loop that goes into this directory, opens all xlsx files one at a time, then copies the sheets within these files to a single workbook. And then from there I create one summary sheet in the same workbook which will then be copied to the main workbook.

Here is the code to get the sheets from the multiple files into one workbook:

Sub ThirdParty2_ImportDataSheets()

Dim x As Workbook
Set x = Workbooks.Open("C:\Users\Desktop\3rd Party\Work Folder\New folder\test.xlsx")

Path = "C:\Users\Desktop\3rd Party\Work Folder\"
Filename = Dir(Path & "*.xlsx")
  Do While Filename <> ""
  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
     For Each Sheet In ActiveWorkbook.Sheets
     Sheet.Copy After:=x.Sheets(1)
  Next Sheet
     Workbooks(Filename).Close
     Filename = Dir()
  Loop
End Sub

I am aware it says "for each sheet copy", however, there will always only be one sheet in the workbook, so it wouldn't copy 2 sheets from the same workbook.

Any thoughts or comments on this is welcome. For now, I will go back to the other thread as this original question has been solved.