Splitting into a new file after Nth Rows

J

jazib

New Member
Joined
Jul 12, 2010
Messages
2
I want to convert a text file which has around 127000 rows to 127 each containing 1000 rows of data. Is that possible using excel? If so who could help me!!!

The file size is around 70MB
 
Last edited:

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Sort by date Sort by votes
Not quite what you asked for but maybe it will do: this will split a file up into separate chunks based on size:-
Code: 
[FONT=Fixedsys]Option Explicit[/FONT]
[FONT=Fixedsys]Option Compare Text[/FONT]
 
[FONT=Fixedsys]Sub MultiFileSplit()[/FONT]
 
[FONT=Fixedsys] Const iMaxSize As Long = [COLOR=red]5[/COLOR]         [COLOR=green]' how many kbytes in each file[/COLOR][/FONT]
[FONT=Fixedsys] Const iPadFactor As Integer = 3    [COLOR=green]' how many digits in file name serial number[/COLOR][/FONT]
 
[FONT=Fixedsys] Dim sInFile As String[/FONT]
[FONT=Fixedsys] Dim inFH As Integer[/FONT]
 
[FONT=Fixedsys] Dim sOutFile As String[/FONT]
[FONT=Fixedsys] Dim sFolder As String[/FONT]
[FONT=Fixedsys] Dim sOutRoot As String[/FONT]
[FONT=Fixedsys] Dim sOutExt As String[/FONT]
[FONT=Fixedsys] Dim outFH As Integer[/FONT]
 
[FONT=Fixedsys] Dim sRecord As String[/FONT]
[FONT=Fixedsys] Dim iSerialNo As Integer[/FONT]
[FONT=Fixedsys] Dim iPtr As Integer[/FONT]
[FONT=Fixedsys] Dim iLines As Long[/FONT]
[FONT=Fixedsys] Dim iTotal As Long[/FONT]
[FONT=Fixedsys] Dim iOutTotal As Long[/FONT]
 
[FONT=Fixedsys] Dim dtStart As Date[/FONT]
 
[FONT=Fixedsys] sInFile = Application.GetOpenFilename(FileFilter:="All file types (*.*), *.*")[/FONT]
[FONT=Fixedsys] If sInFile = "False" Then Exit Sub[/FONT]
 
[FONT=Fixedsys] sOutFile = Application.GetSaveAsFilename(FileFilter:="Text Files (*.txt), *.txt")[/FONT]
[FONT=Fixedsys] If sOutFile = "False" Then Exit Sub[/FONT]
 
[FONT=Fixedsys] dtStart = Now()[/FONT]
 
[FONT=Fixedsys] iPtr = InStrRev(sOutFile, ".")[/FONT]
[FONT=Fixedsys] If iPtr = 0 Then[/FONT]
[FONT=Fixedsys]   sOutRoot = sOutFile[/FONT]
[FONT=Fixedsys]   sOutExt = ""[/FONT]
[FONT=Fixedsys] Else[/FONT]
[FONT=Fixedsys]   sOutRoot = Left(sOutFile, iPtr - 1)[/FONT]
[FONT=Fixedsys]   sOutExt = Mid(sOutFile, iPtr)[/FONT]
[FONT=Fixedsys] End If[/FONT]
[FONT=Fixedsys] iPtr = InStrRev(sOutRoot, "\")[/FONT]
[FONT=Fixedsys] sFolder = Left(sOutRoot, iPtr)[/FONT]
 
[FONT=Fixedsys] iSerialNo = 1[/FONT]
[FONT=Fixedsys] iTotal = 0[/FONT]
[FONT=Fixedsys] sOutFile = sOutRoot & Right(String(iPadFactor, "0") & CStr(iSerialNo), iPadFactor) & sOutExt[/FONT]
[FONT=Fixedsys] Do Until Dir(sOutFile) = ""[/FONT]
[FONT=Fixedsys]   iTotal = iTotal + 1[/FONT]
[FONT=Fixedsys]   iSerialNo = iSerialNo + 1[/FONT]
[FONT=Fixedsys]   sOutFile = sOutRoot & Right(String(iPadFactor, "0") & CStr(iSerialNo), iPadFactor) & sOutExt[/FONT]
[FONT=Fixedsys] Loop[/FONT]
[FONT=Fixedsys] If iTotal > 0 Then[/FONT]
[FONT=Fixedsys]   If iTotal = 1 Then[/FONT]
[FONT=Fixedsys]     iPtr = MsgBox("There is a file with your selected output file name in " & sFolder _[/FONT]
[FONT=Fixedsys]          & vbCrLf & vbCrLf _[/FONT]
[FONT=Fixedsys]          & "Delete it before running?" & Space(15), vbYesNo + vbQuestion)[/FONT]
[FONT=Fixedsys]   Else[/FONT]
[FONT=Fixedsys]     iPtr = MsgBox("There are " & CStr(iTotal) & " files with your selected output file name in " & sFolder _[/FONT]
[FONT=Fixedsys]          & vbCrLf & vbCrLf _[/FONT]
[FONT=Fixedsys]          & "Delete them before running?" & Space(15), vbYesNo + vbQuestion)[/FONT]
[FONT=Fixedsys]   End If[/FONT]
[FONT=Fixedsys]   If iPtr = vbNo Then[/FONT]
[FONT=Fixedsys]     MsgBox "Processing stopped at user's request.", vbOKOnly + vbExclamation[/FONT]
[FONT=Fixedsys]     Exit Sub[/FONT]
[FONT=Fixedsys]   End If[/FONT]
[FONT=Fixedsys] End If[/FONT]
 
[FONT=Fixedsys] iSerialNo = 1[/FONT]
[FONT=Fixedsys] iTotal = 0[/FONT]
[FONT=Fixedsys] sOutFile = sOutRoot & Right(String(iPadFactor, "0") & CStr(iSerialNo), iPadFactor) & sOutExt[/FONT]
[FONT=Fixedsys] Do Until Dir(sOutFile) = ""[/FONT]
[FONT=Fixedsys]   Kill sOutFile[/FONT]
[FONT=Fixedsys]   iSerialNo = iSerialNo + 1[/FONT]
[FONT=Fixedsys]   sOutFile = sOutRoot & Right(String(iPadFactor, "0") & CStr(iSerialNo), iPadFactor) & sOutExt[/FONT]
[FONT=Fixedsys] Loop[/FONT]
 
[FONT=Fixedsys] iSerialNo = 1[/FONT]
[FONT=Fixedsys] Close[/FONT]
[FONT=Fixedsys] inFH = FreeFile()[/FONT]
[FONT=Fixedsys] Open sInFile For Input As #inFH[/FONT]
[FONT=Fixedsys] iOutTotal = LOF(inFH)[/FONT]
[FONT=Fixedsys] outFH = FreeFile()[/FONT]
[FONT=Fixedsys] sOutFile = sOutRoot & Right(String(iPadFactor, "0") & CStr(iSerialNo), iPadFactor) & sOutExt[/FONT]
[FONT=Fixedsys] Open sOutFile For Output As #outFH[/FONT]
[FONT=Fixedsys] iLines = 0[/FONT]
[FONT=Fixedsys] iTotal = 0[/FONT]
 
[FONT=Fixedsys] Do Until EOF(inFH)[/FONT]
[FONT=Fixedsys]   Line Input #inFH, sRecord[/FONT]
[FONT=Fixedsys]   If LOF(outFH) >= iMaxSize * 1024 Then[/FONT]
[FONT=Fixedsys]     Close #outFH[/FONT]
[FONT=Fixedsys]     iSerialNo = iSerialNo + 1[/FONT]
[FONT=Fixedsys]     outFH = FreeFile()[/FONT]
[FONT=Fixedsys]     sOutFile = sOutRoot & Right(String(iPadFactor, "0") & CStr(iSerialNo), iPadFactor) & sOutExt[/FONT]
[FONT=Fixedsys]     Open sOutFile For Output As #outFH[/FONT]
[FONT=Fixedsys]     iLines = 0[/FONT]
[FONT=Fixedsys]   End If[/FONT]
[FONT=Fixedsys]   Print #outFH, sRecord[/FONT]
[FONT=Fixedsys]   iLines = iLines + 1[/FONT]
[FONT=Fixedsys]   iTotal = iTotal + 1[/FONT]
[FONT=Fixedsys] Loop[/FONT]
 
[FONT=Fixedsys] Close #outFH[/FONT]
[FONT=Fixedsys] Close #inFH[/FONT]
 
[FONT=Fixedsys] iPtr = InStrRev(sOutRoot, "\")[/FONT]
[FONT=Fixedsys] sOutRoot = Mid(sOutRoot, iPtr + 1)[/FONT]
 
[FONT=Fixedsys] MsgBox "Done:-" & vbCrLf & vbCrLf _[/FONT]
[FONT=Fixedsys]     & CStr(iTotal) & " records in " & sInFile & " (" & CStr(Int(iOutTotal / 1024)) & "kb)" _[/FONT]
[FONT=Fixedsys]     & vbCrLf & vbCrLf _[/FONT]
[FONT=Fixedsys]     & CStr(iSerialNo) & " files created: " _[/FONT]
[FONT=Fixedsys]     & sFolder & sOutRoot & String(iPadFactor - 1, "0") & "1" & sOutExt _[/FONT]
[FONT=Fixedsys]     & "-" & sOutRoot & String(iPadFactor, "0") & CStr(iSerialNo) & sOutExt _[/FONT]
[FONT=Fixedsys]     & " (max. " & CStr(iMaxSize) & "kb)" _[/FONT]
[FONT=Fixedsys]     & vbCrLf & vbCrLf _[/FONT]
[FONT=Fixedsys]     & "Run time: " & Format(Now() - dtStart, "hh:nn:ss"), vbOKOnly + vbInformation[/FONT]
 
[FONT=Fixedsys]End Sub[/FONT]
Drop it straight into a new general code module, change iMaxSize to your desired file size and run it. You're prompted for the input file and the name of your output file - this will have 001 appended to it, then 002, etc.

I guess you want to set iMaxSize to a little bit more than 1/27th of the size of your input file to start with.
 
Upvote 0
It only needed a very small change to make it work on the number of lines:-
Code: 
[FONT=Fixedsys]Option Explicit
Option Compare Text[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]Sub MultiFileSplitByLines()[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]  Const iMaxLines As Long = [COLOR=red]1000[/COLOR]     [COLOR=green]' how many lines in each file[/COLOR]
  Const iPadFactor As Integer = 4  [COLOR=green]  ' how many digits in file name serial number[/COLOR][/FONT]
[FONT=Fixedsys][COLOR=#008000][/COLOR][/FONT] 
[FONT=Fixedsys]  Dim sInFile As String
  Dim inFH As Integer
  
  Dim sOutFile As String
  Dim sFolder As String
  Dim sOutRoot As String
  Dim sOutExt As String
  Dim outFH As Integer
  
  Dim sRecord As String
  Dim iSerialNo As Integer
  Dim iPtr As Integer
  Dim iLines As Long
  Dim iTotal As Long
  Dim iOutTotal As Long
  
  Dim dtStart As Date
  
  sInFile = Application.GetOpenFilename(FileFilter:="All file types (*.*), *.*")
  If sInFile = "False" Then Exit Sub
  
  sOutFile = Application.GetSaveAsFilename(InitialFileName:="", FileFilter:="Text Files (*.txt), *.txt")
  If sOutFile = "False" Then Exit Sub
  
  dtStart = Now()
  
  iPtr = InStrRev(sOutFile, ".")
  If iPtr = 0 Then
    sOutRoot = sOutFile
    sOutExt = ""
  Else
    sOutRoot = Left(sOutFile, iPtr - 1)
    sOutExt = Mid(sOutFile, iPtr)
  End If
  iPtr = InStrRev(sOutRoot, "\")
  sFolder = Left(sOutRoot, iPtr)
  
  iSerialNo = 1
  iTotal = 0
  sOutFile = sOutRoot & Right(String(iPadFactor, "0") & CStr(iSerialNo), iPadFactor) & sOutExt
  Do Until Dir(sOutFile) = ""
    iTotal = iTotal + 1
    iSerialNo = iSerialNo + 1
    sOutFile = sOutRoot & Right(String(iPadFactor, "0") & CStr(iSerialNo), iPadFactor) & sOutExt
  Loop
  If iTotal > 0 Then
    If iTotal = 1 Then
      iPtr = MsgBox("There is a file with your selected output file name in " & sFolder _
           & vbCrLf & vbCrLf _
           & "Delete it before running?" & Space(15), vbYesNo + vbQuestion)
    Else
      iPtr = MsgBox("There are " & CStr(iTotal) & " files with your selected output file name in " & sFolder _
           & vbCrLf & vbCrLf _
           & "Delete them before running?" & Space(15), vbYesNo + vbQuestion)
    End If
    If iPtr = vbNo Then
      MsgBox "Processing stopped at user's request.", vbOKOnly + vbExclamation
      Exit Sub
    End If
  End If
  
  iSerialNo = 1
  iTotal = 0
  sOutFile = sOutRoot & Right(String(iPadFactor, "0") & CStr(iSerialNo), iPadFactor) & sOutExt
  Do Until Dir(sOutFile) = ""
    Kill sOutFile
    iSerialNo = iSerialNo + 1
    sOutFile = sOutRoot & Right(String(iPadFactor, "0") & CStr(iSerialNo), iPadFactor) & sOutExt
  Loop
  
  iSerialNo = 1
  Close
  inFH = FreeFile()
  Open sInFile For Input As #inFH
  iOutTotal = LOF(inFH)
  outFH = FreeFile()
  sOutFile = sOutRoot & Right(String(iPadFactor, "0") & CStr(iSerialNo), iPadFactor) & sOutExt
  Open sOutFile For Output As #outFH
  iLines = 0
  iTotal = 0
  
  Do Until EOF(inFH)
    Line Input #inFH, sRecord
    If iLines >= iMaxLines Then
      Close #outFH
      iSerialNo = iSerialNo + 1
      outFH = FreeFile()
      sOutFile = sOutRoot & Right(String(iPadFactor, "0") & CStr(iSerialNo), iPadFactor) & sOutExt
      Open sOutFile For Output As #outFH
      iLines = 0
    End If
    Print #outFH, sRecord
    iLines = iLines + 1
    iTotal = iTotal + 1
  Loop
  
  Close #outFH
  Close #inFH
  
  iPtr = InStrRev(sOutRoot, "\")
  sOutRoot = Mid(sOutRoot, iPtr + 1)
  
  MsgBox "Done:-" & vbCrLf & vbCrLf _
      & CStr(iTotal) & " records in " & sInFile _
      & vbCrLf & vbCrLf _
      & CStr(iSerialNo) & " files created: " _
      & sFolder & sOutRoot & String(iPadFactor - 1, "0") & "1" & sOutExt _
      & "-" & sOutRoot & String(iPadFactor, "0") & CStr(iSerialNo) & sOutExt _
      & " (max. " & CStr(iMaxLines) & " lines)" _
      & vbCrLf & vbCrLf _
      & "Run time: " & Format(Now() - dtStart, "hh:nn:ss"), vbOKOnly + vbInformation[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]End Sub[/FONT]
Change iMaxLines to set the size of your output files.
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Solved
Splitting up an excel file to multiple tabs by "visible" rows.
2
Replies
11
Views
241
BasicUserWithExp
B
T
  • Question Question
How can I reduce file size of workbook referencing sheets in another workbook?
Replies
4
Views
236
bobsan42
bobsan42
F
  • Question Question
VBA code that finds a value in a col. then returns entire row
Replies
3
Views
148
Fudging
F
P
  • Solved
VBA to insert filename in a new column for all files in a folder
Replies
2
Views
119
psion2600
P
C
  • Solved
Extracting data with VBA macro button from files in designated folder
2 3
Replies
20
Views
1K
Micron
M

Forum statistics

Threads
1,224,618
Messages
6,179,919
Members
452,949
Latest member
beartooth91

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top