Split rows separated by blank row and create multiple files

[PANIGGR]

I have a tab with more than 10000 rows separated by block of data separated by a blank row. Each block has header. I need multiple files based on each block of data based on the column A. Each file to be named based on column F (Payment Amt)

sample data as follows,

H	DPA	Payment Number	Payment Amt	Settlement Date	Payment File ID	Processing Fees	Amount Paid to Collector	Remittance Type	Remit Number
D	1029290387	15022755	1,186.74	10/18/2024	650941980	0	1,186.74	Basic Remittance	1
D								Basic Remittance	2
D								Basic Remittance	3
D								Basic Remittance	4
H	DPA	Payment Number	Payment Amt	Settlement Date	Payment File ID	Processing Fees	Amount Paid to Collector	Remittance Type	Remit Number
D	1029290397	18005726	51.95	10/18/2024	650941980	0	51.95	Basic Remittance	1
D								Basic Remittance	2
H	DPA	Payment Number	Payment Amt	Settlement Date	Payment File ID	Processing Fees	Amount Paid to Collector	Remittance Type	Remit Number
D	1028937517	50064	67.3	10/18/2024	650902258	0	67.30	Basic Remittance	1
H	DPA	Payment Number	Payment Amt	Settlement Date	Payment File ID	Processing Fees	Amount Paid to Collector	Remittance Type	Remit Number
D	1029309776	35884	623.31	10/18/2024	650944972	0	623.31	Expanded	1
D								Expanded	2
D								Expanded	3

 

[HighAndWilder]

I have a tab with more than 10000 rows separated by block of data separated by a blank row. Each block has header. I need multiple files based on each block of data based on the column A. Each file to be named based on column F (Payment Amt)

sample data as follows,

H	DPA	Payment Number	Payment Amt	Settlement Date	Payment File ID	Processing Fees	Amount Paid to Collector	Remittance Type	Remit Number
D	1029290387	15022755	1,186.74	10/18/2024	650941980	0	1,186.74	Basic Remittance	1
D								Basic Remittance	2
D								Basic Remittance	3
D								Basic Remittance	4
H	DPA	Payment Number	Payment Amt	Settlement Date	Payment File ID	Processing Fees	Amount Paid to Collector	Remittance Type	Remit Number
D	1029290397	18005726	51.95	10/18/2024	650941980	0	51.95	Basic Remittance	1
D								Basic Remittance	2
H	DPA	Payment Number	Payment Amt	Settlement Date	Payment File ID	Processing Fees	Amount Paid to Collector	Remittance Type	Remit Number
D	1028937517	50064	67.3	10/18/2024	650902258	0	67.30	Basic Remittance	1
H	DPA	Payment Number	Payment Amt	Settlement Date	Payment File ID	Processing Fees	Amount Paid to Collector	Remittance Type	Remit Number
D	1029309776	35884	623.31	10/18/2024	650944972	0	623.31	Expanded	1
D								Expanded	2
D								Expanded	3

Try this on a copy of your data.

There are a few changes that you will need to make.

These are indicated at the start of the code.

Public Sub subSplitSaveData()
Dim strPath As String
Dim rng As Range
Dim Ws As Worksheet
Dim intCount As Integer
Dim strSheetName As String

  ActiveWorkbook.Save

  ' Change 'Data' to the name of the sheet containing the data.
  Set Ws = Worksheets("Data")
  
  ' Change this to the path where the new workbooks are to be saved.
  strPath = ActiveWorkbook.Path & "\"
    
  ' Change 'Data' to what the new workbook sheet is be named.
  strSheetName = "Data"
  
  Application.DisplayAlerts = False
  
  On Error Resume Next
  Worksheets("Split").Delete
  On Error GoTo 0
  Worksheets.Add after:=Ws
  ActiveSheet.Name = "Split"
  
  Ws.Range("A1").EntireRow.Insert

  Application.ScreenUpdating = False

  For Each rng In Ws.UsedRange.Columns(1).Cells
  
    If IsEmpty(rng) Then
      
      With Worksheets("Split")
        .Cells.Clear
        rng.Offset(1, 0).CurrentRegion.Copy .Range("A1")
        .Copy
        With ActiveWorkbook
          With .Sheets(1)
            .Name = strSheetName
            .Cells.EntireColumn.AutoFit
          End With
          On Error Resume Next
          Kill (strPath & rng.Offset(2, 5))
          On Error GoTo 0
          .SaveAs strPath & rng.Offset(2, 5)
          .Close False
        End With
        intCount = intCount + 1
      End With
     
    End If
  
  Next rng
  
  Ws.Range("A1").EntireRow.Delete
  
  Application.DisplayAlerts = True
  
  Application.ScreenUpdating = True
  
  Ws.Activate

  MsgBox intCount & " workbooks created.", vbOKOnly, "Confirmation"

End Sub

 

[Kaper]

Edit - posted just few seconds later But uses a bit different approach
You could use such macro:

Sub separatefiles()
Dim i As Long, j As Long, fname As String
Application.ScreenUpdating = False
j = Cells(Rows.Count, "J").End(xlUp).Row
While j > 1
  i = Cells(j, "J").End(xlUp).Row
  fname = Replace(Cells(i + 1, "D"), ",", "_") 'just in case you have comma in amount - it is not allowed in filename
  Range(Cells(i, "A"), Cells(j, "K")).Copy
  Workbooks.Add
  ActiveSheet.Paste
  ActiveWorkbook.SaveAs Filename:=fname & ".xlsx"
  ActiveWorkbook.Close False
  j = i - 2
Wend
Application.ScreenUpdating = True
End Sub

Final comments - I noticed in sample date the amount is in columnD not E. If it's in E correct this line

  fname = Replace(Cells(i + 1, "E"), ",", "_") 'just in case you have comma in amount - it is not allowed in filename

The resulting files have standard sheet1 name.
You start the macro having your sheet with data to be splitted open.
The files will be saved to default folder. If you need to change it add the path to this line, in a similar way (use your folder path :

  ActiveWorkbook.SaveAs Filename:= "C:\Users\Kaper\Test\" & fname & ".xlsx"

 

[Kaper]

Edit - few seconds before posting I saw a message that the answer was posted.
Anyway ... I'm not deleting it, because it uses a bit different approach.

Final comment - both codes will be not-very-quick. So test on a small sample (may be some 10 records). If it works as expected - delete produced files and rerun on whole data. Probably there will be a time for a coffe or for a quick phone call while 10 000 rows are processed

 

[HighAndWilder]

Edit - posted just few seconds later But uses a bit different approach
You could use such macro:

Sub separatefiles()
Dim i As Long, j As Long, fname As String
Application.ScreenUpdating = False
j = Cells(Rows.Count, "J").End(xlUp).Row
While j > 1
  i = Cells(j, "J").End(xlUp).Row
  fname = Replace(Cells(i + 1, "D"), ",", "_") 'just in case you have comma in amount - it is not allowed in filename
  Range(Cells(i, "A"), Cells(j, "K")).Copy
  Workbooks.Add
  ActiveSheet.Paste
  ActiveWorkbook.SaveAs Filename:=fname & ".xlsx"
  ActiveWorkbook.Close False
  j = i - 2
Wend
Application.ScreenUpdating = True
End Sub

Final comments - I noticed in sample date the amount is in columnD not E. If it's in E correct this line

  fname = Replace(Cells(i + 1, "E"), ",", "_") 'just in case you have comma in amount - it is not allowed in filename

The resulting files have standard sheet1 name.
You start the macro having your sheet with data to be splitted open.
The files will be saved to default folder. If you need to change it add the path to this line, in a similar way (use your folder path :

  ActiveWorkbook.SaveAs Filename:= "C:\Users\Kaper\Test\" & fname & ".xlsx"

Always good to see different approaches Kaper.

I assumed that the filename was taken from column F, Payment File ID.
This is, hopefully, unique.

Paniggr did say Payment Amt though.

This process will take a long time on more than 10000 rows.

 

[PANIGGR]

Edit - few seconds before posting I saw a message that the answer was posted.
Anyway ... I'm not deleting it, because it uses a bit different approach.

Final comment - both codes will be not-very-quick. So test on a small sample (may be some 10 records). If it works as expected - delete produced files and rerun on whole data. Probably there will be a time for a coffe or for a quick phone call while 10 000 rows are processed

It worked, i tweaked the column reference to rename the file name for each block based on Payment Number. Is it possible to give the file name with Amount and Payment Number from two columns, like 50043547 and 142.53

 

[Kaper]

To have name created from columns C (pmt nr) and D (pmt amt) you may use for instance such ammended line of code with fname (filename) creation:

  fname = Cells(i + 1, "C") & "_" & Replace(Cells(i + 1, "D"), ",", "_")

 

[PANIGGR]

To have name created from columns C (pmt nr) and D (pmt amt) you may use for instance such ammended line of code with fname (filename) creation:

  fname = Cells(i + 1, "C") & "_" & Replace(Cells(i + 1, "D"), ",", "_")

Thank you so much

 

[Kaper]

Glad to hear so. You may mark my previous post as a solution Mark as Solution (if you decided to use my code)