Splitting Excel File Data Randomly into Multiple Files
Today, we would like to introduce a sample application that splits randomly arranged data into separate files based on specific criteria. This sample code can be useful in various scenarios, such as dividing a single file into departments or separating files for different business partners to send via email. For the previous sample application on “Splitting Sorted Excel Data into Multiple Files," please refer to the following website:
Please check the previous sample file at the following URL
https://scodebank.com/?p=1439&lang=en
Description of the Sample Application
By clicking the “Split Excel files" button, the file will be split based on the workplace.
The resulting split files will be organized as follows.
Content of the file named “Boston, Massachusetts_202306.xlsx"
Content of the file named “Los Angeles, California_202306.xlsx"
Content of the file named “New York City, New York_202306.xlsx"
Content of the file named “Washington, D.C._202306.xlsx"
Processing Steps in the Sample Code
In this case, we are defining a list and performing processing on each segmented file using a loop. For example, in the following scenario, we store the file for Boston, Massachusetts in WB(1), the file for Los Angeles, California in WB(2), the file for New York City, New York in WB(3), and the file for Washington, D.C. in WB(4). Subsequently, the processing is carried out on WB(1), WB(2), WB(3), and WB(4).
For n = 1 To 4
Set WB(n) = Workbooks.Add
Next nThe overall processing steps are as follows:
- Specify the source file and sheet for splitting.
- Specify the destination path for the split files.
- Create a new workbook for each split file.
- Specify the destination sheet and copy the data for each workplace.
- Save the split files for each workplace.
Sample Code Here are the steps to create the app
Option Explicit
Sub Export_ExcelFile()
' Define variables to store the source workbook
Dim TWB As Workbook ' This workbook
' Assuming the list will be divided into 4 files
Const w As Integer = 4
' Define variables to store the destination workbooks as a list
Dim WB(1 To w) As Workbook
' Define variables to store the file names as a list
Dim FileNam(1 To w) As String
' Define a variable to store the output path
Dim xPath As String
' Define a variable as the key to split the files
Dim key As String
' Define variables to count the source data
Dim i As Integer
Dim n As Integer
' Define variables to count the data in each split file
Dim ne As Integer
Dim b As Integer
Dim wa As Integer
Dim l As Integer
' Initialize the count variables for each file
ne = 6
b = 6
wa = 6
l = 6
' Define a variable for the source worksheet
Dim Sh1 As Worksheet
' Specify the source worksheet
Set Sh1 = ThisWorkbook.Worksheets("List of Commute Allowances")
' Define variables for the destination worksheets as a list
Dim ShT1(1 To w) As Worksheet
' Set the source Excel workbook to the variable
Set TWB = ThisWorkbook
' Set the destination path for the split files
With ActiveWorkbook
xPath = .Path & "\" ' Specify the path from the folder where the file is located
End With
' Create new workbooks
For n = 1 To 4
Set WB(n) = Workbooks.Add
Next n
' Set the names of the destination sheets in the split files
For n = 1 To 4
WB(n).Sheets("Sheet1").Name = "List of Commute Allowances"
Next
' Specify the destination worksheets
For n = 1 To 4
Set ShT1(n) = WB(n).Worksheets("List of Commute Allowances")
Next
' Get the output date
Dim strDate As String
strDate = DateSerial(Year(Now), Month(Now) - 1, 1)
strDate = Format(strDate, "yyyymm")
' Specify the output paths for the Excel files
FileNam(1) = xPath & "New York City, New York" & "_" & strDate & ".xlsx"
FileNam(2) = xPath & "Boston, Massachusetts" & "_" & strDate & ".xlsx"
FileNam(3) = xPath & "Washington, D.C." & "_" & strDate & ".xlsx"
FileNam(4) = xPath & "Los Angeles, California" & "_" & strDate & ".xlsx"
' Copy the title row to the destination sheets in the split files
For n = 1 To 4
Sh1.Range(Sh1.Cells(5, 2), Sh1.Cells(5, 7)).Copy ShT1(n).Range("B5")
Next
' Loop through the data section *******************************
' Specify the starting row of the data (starting from row 6)
Dim start As Long
start = 6
' Loop while the employee number continues
Do While Sh1.Cells(start, 2).Value <> ""
' Get the first location of the source data
key = Sh1.Cells(start, 6).Value
' If the location is "New York City, New York", copy the data to the corresponding file
If key = "New York City, New York" Then
' Copy the data row
Sh1.Range(Sh1.Cells(start, 1), Sh1.Cells(start, 7)).Copy ShT1(1).Range("A" & ne)
' Update the count
ne = ne + 1
End If
' If the location is "Boston, Massachusetts", copy the data to the corresponding file
If key = "Boston, Massachusetts" Then
' Copy the data row
Sh1.Range(Sh1.Cells(start, 1), Sh1.Cells(start, 7)).Copy ShT1(2).Range("A" & b)
' Update the count
b = b + 1
End If
' If the location is "Washington, D.C.", copy the data to the corresponding file
If key = "Washington, D.C." Then
' Copy the data row
Sh1.Range(Sh1.Cells(start, 1), Sh1.Cells(start, 7)).Copy ShT1(3).Range("A" & wa)
' Update the count
wa = wa + 1
End If
' If the location is "Los Angeles, California", copy the data to the corresponding file
If key = "Los Angeles, California" Then
' Copy the data row
Sh1.Range(Sh1.Cells(start, 1), Sh1.Cells(start, 7)).Copy ShT1(4).Range("A" & l)
' Update the count
l = l + 1
End If
' Shift the source data row down by one.
start = start + 1
Loop
'Save the split files ************************************************
For n = 1 To 4
' Adjust the column widths in the split files.
WB(n).Worksheets("List of Commute Allowances").Range("B:G").Columns.AutoFit
' Save and close the split files
WB(n).SaveAs Filename:=FileNam(n)
WB(n).Close
' Release the split file workbooks
Set WB(n) = Nothing
Next
' Display completion message
MsgBox "The splitting process has been completed."
End Sub