Sculpt

This code shows you how to compile data from several similarly-structured workbooks into one worksheet. It utilises much of the code from the previous two posts, Check a worksheet exists in a specifed workbook and List files in a specified folder.

First off, place all workbooks that need compiling into a distinct folder. In this example, I’ve placed them in:

C:\Documents and Settings\[username]\My Documents\Excel Application Development\MyWorkbooks\Workbooks\COMPILE\

The example gets all data from worksheet “Data” in the folder’s workbooks, compiling them as a list into this workbook. This code assumes the workbooks have exactly the same structure – therefore, values in column A are compiled to the new worksheet’s column A, column B to column B, etc…. We’ll use the Folder Dialog to find the location of the workbooks. Place this function in a blank module:
____________________________

Public Function GetFolder() As Variant

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim vrtSelectedItem As Variant

With fd
.Title = “Select folder…” ‘customise the dialog box title
.InitialFileName = “C:\Documents and Settings\[username]\My Documents\Excel Application Development\My Workbooks\Workbooks\COMPILE\” ‘initial folder name to ‘display
‘The user pressed the action button.
If .Show = -1 Then
‘Step through each string in the FileDialogSelectedItems collection.
For Each vrtSelectedItem In .SelectedItems
‘The example declares the folder as a variant that’s used in the sub above.
GetFolder = vrtSelectedItem
Next vrtSelectedItem
Else
End If
End With

Set fd = Nothing

End Function
____________________________

When running through the workbooks, we’ll also want to make sure the worksheet “Data” exists in each workbook. To do this, use this function:
____________________________

Public Function SheetExists(SheetName As String) As Boolean
‘Returns True if the sheet exists in the active workbook
SheetExists = False
On Error GoTo NoSuchSheet

If Len(Sheets(SheetName).Name) > 0 Then
SheetExists = True
Exit Function
End If

NoSuchSheet:

End Function

____________________________

The next thing we’ll need is some code that loops through all files in the specifed folder, checks that they are Excel workbooks, additionally checks they contain the worksheet “Data”, then if these conditions are met, compiles the data into our worksheet. To do this, we’ll amend the code we used here when listing files in a specifed folder. Ensure you enable the Microsoft ScriptingRuntime reference for this to work.

____________________________

Sub ListFilesInFolder(SourceFolderName As String)

Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim i As Integer
Dim x As Integer

On Error GoTo ErrHandler ‘If the SourceFolderName from GetFolder is empty

Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
i = 2 ‘Start row to compile data in ThisWorkbook

For Each FileItem In SourceFolder.Files ‘Loops through files in GetFolder
If FileItem.Type = “Microsoft Excel Worksheet” Then ‘Ignores non-excel files
myFile = FileItem.Name
Workbooks.Open (myFile)

If SheetExists(“Data”) = True Then ‘Check if worksheet contains “Data” worksheet
‘Compile the data from here
x = 2 ‘Start row of each opened workbook
Do Until Workbooks(myFile).Worksheets(“Data”).Cells(x, 1).Value = “”
‘Change this code as required for your worksheet structure
Workbooks(ThisWorkbook.Name).Worksheets(“Data”).Cells(i, 1).Value = _
Workbooks(myFile).Worksheets(“Data”).Cells(x, 1).Value
Workbooks(ThisWorkbook.Name).Worksheets(“Data”).Cells(i, 2).Value = _
Workbooks(myFile).Worksheets(“Data”).Cells(x, 2).Value
Workbooks(ThisWorkbook.Name).Worksheets(“Data”).Cells(i, 3).Value = _
Workbooks(myFile).Worksheets(“Data”).Cells(x, 3).Value
Workbooks(ThisWorkbook.Name).Worksheets(“Data”).Cells(i, 4).Value = _
Workbooks(myFile).Worksheets(“Data”).Cells(x, 4).Value
x = x + 1
i = i + 1
Loop
Else
End If
Workbooks(myFile).Close False
End If
Next FileItem ‘Loops through next file

Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing

ErrHandler:
‘If SourceFolderName from GetFolder is empty
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
Exit Sub

End Sub
____________________________

The final bit of code calls ListFilesInFolder(SourceFolderName As String):
____________________________

Sub TestListFilesInFolder()

ListFilesInFolder GetFolder

End Sub
____________________________

To run this, just change the worksheet name and amend the required columns. Run the process from TestListFilesInFolder, selecting the folder from the Folder Dialog box.

____________________________