Split Master File Into Multiple Smaller Files

ir121973

Active Member
Joined
Feb 9, 2008
Messages
371
Hi, I wonder if someone could help please.

I'm using the code below (found here: http://sitestory.dk/excel_vba/split-textfiles.htm) to split a master file into multiple smaller ones.


Code:
Sub SplitTextFile()
'Splits a text or csv file into smaller files
'with a user defined number (max) of lines or
'rows. The new files get the original file
'name + a number (1, 2, 3 etc.).


Dim sFile As String  'Name of the original file
Dim sText As String  'The file text
Dim lStep As Long    'Max number of lines in the new files
Dim vX, vY           'Variant arrays. vX = input, vY = output
Dim iFile As Integer 'File number from Windows
Dim lCount As Long   'Counter
Dim lIncr As Long    'Number for file name
Dim lMax As Long     'Upper limit for loop
Dim lNb As Long      'Counter
Dim lSoFar As Long   'How far did we get?


On Error GoTo ErrorHandle


'Select a file
sFile = Application.GetOpenFilename()


'If the user cancelled
If sFile = "False" Then Exit Sub


'Ask the user for max number of lines per file. E.g. 65536
lStep = Application.InputBox("Max number of lines/rows?", Type:=1)


'Our arrays have zero as LBound, so we subtract 1
lStep = lStep - 1


'Read the file text to sText
sText = _
CreateObject("Scripting.FileSystemObject").OpenTextFile(sFile).ReadAll


'Put the text into the array vX. Linefeed chars (new
'line) will add a new row to the array.
'If linefeed doesn't work try:
''vX = Split(sText, vbCrLf)
'which is Carriage return–linefeed kombination
vX = Split(sText, vbLf)


'Free memory
sText = ""


'Now we start a loop that will run until all
'rows in the array have been read and saved
'into new files. The variable lSoFar keeps
'track of how far we are in vX.
Do While lSoFar < UBound(vX)
   'If the number of rows minus lSoFar is
   'bigger than max number of rows, the
   'array vY is dimensioned to max number
   'of rows.
   If UBound(vX) - lSoFar >= lStep Then
      ReDim vY(lStep)
      'lMax is set = last rownumber to be
      'copied to vY.
      lMax = lStep + lSoFar
   Else
      'Else we dimension vY to the number of
      'rows left.
      ReDim vY(UBound(vX) - lSoFar)
      'Last row to copy is last row in vX
      lMax = UBound(vX)
   End If
   
   lNb = 0
   'Now we copy the rows from vX to vY
   For lCount = lSoFar To lMax
      vY(lNb) = vX(lCount)
      lNb = lNb + 1
   Next
   
   'lSoFar keeps track of how far we got in vX
   lSoFar = lCount
   
   'Get a free file number
   iFile = FreeFile
   
   'Increment the number for the new file name
   lIncr = lIncr + 1
 
   'Save vY as a text file (.txt). It could also be a csv-file,
   'but then you need to replace txt with csv.
   Open sFile & "-" & lIncr & ".csv" For Output As #iFile
      'The Join function makes a text
      'string from the array elements.
      Print #iFile, Join$(vY, vbCrLf)
   Close #iFile
Loop


Erase vX
Erase vY


Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure SplitTextFile"
End Sub


The code works, but there two issues which I can't seem to resolve:


  • When the rows are pasted into the smaller files, there is always a blank row in between, even though the master file didn't contain them, and
  • I'd like to copy the header row from the master file into each of the smaller files.

My knowledge of VB is getting better, albeit slowly, but these have got me stumped.

I just wondered whether someone may be able to offer some guidance on how I could achieve these please?

Many thanks and kind regards

Chris
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Hi,

tweaked a little bit see the bold red parts
Code:
Sub SplitTextFile()
Dim sFile As String  'Name of the original file
Dim sText As String  'The file text
Dim lStep As Long    'Max number of lines in the new files
Dim vX, vY           'Variant arrays. vX = input, vY = output
Dim iFile As Integer 'File number from Windows
Dim lCount As Long   'Counter
Dim lIncr As Long    'Number for file name
Dim lMax As Long     'Upper limit for loop
Dim lNb As Long      'Counter
Dim lSoFar As Long   'How far did we get?
On Error GoTo ErrorHandle
sFile = Application.GetOpenFilename()
If sFile = "False" Then Exit Sub


lStep = Application.InputBox("Max number of lines/rows?", Type:=1)[COLOR=#ff0000][B]+1[/B][/COLOR]


lStep = lStep - 1
sText = _
CreateObject("Scripting.FileSystemObject").OpenTextFile(sFile).ReadAll
vX = Split(sText, vbLf)
sText = ""
Do While lSoFar < UBound(vX)
   If UBound(vX) - lSoFar >= lStep Then
      ReDim vY(lStep)
      lMax = lStep + lSoFar
   Else
      ReDim vY(UBound(vX) - lSoFar)
      lMax = UBound(vX)
   End If
   
[B][COLOR=#ff0000]   If lSoFar = 0 Then[/COLOR][/B]
[B][COLOR=#ff0000]   lNb = 0[/COLOR][/B]
[B][COLOR=#ff0000]   lMax = lMax[/COLOR][/B]
[B][COLOR=#ff0000]   Else[/COLOR][/B]
[B][COLOR=#ff0000]   lMax = lMax - 1[/COLOR][/B]
[B][COLOR=#ff0000]   lNb = 1[/COLOR][/B]
[B][COLOR=#ff0000]   End If[/COLOR][/B]


   For lCount = lSoFar To lMax
  [COLOR=#ff0000][B] vY(0) = vX(0)[/B][/COLOR]
      vY(lNb) = vX(lCount)
      lNb = lNb + 1
   Next
   lSoFar = lCount
   iFile = FreeFile
   lIncr = lIncr + 1
   Open sFile & "-" & lIncr & ".csv" For Output As #iFile
      Print #iFile, Join$(vY, vbCrLf)
   Close #iFile
Loop
Erase vX
Erase vY
Exit Sub

ErrorHandle:
MsgBox Err.Description & " Procedure SplitTextFile"
End Sub

It will copy the headline (first row) to every array which will be written into CSV, but headlines dont count as rows so if you write 2000 it will be 2001, with 1 line headline and 2000 rows of data.Tested it on a 7732 rows csv.
Please test in a sample file of yours.
 
Last edited:
Upvote 0
Hi @CsJHUN, thank you very much for taking the time to reply to my post.

The solution of splitting the file works great, thank you! but I still have issues in that it pastes the rows into the smaller on alternate rows.

Any ideas please?

Many thanks and kind regards

Chris
 
Upvote 0
Hi @CsJHUN, thank you very much for taking the time to reply to my post.

The solution of splitting the file works great, thank you! but I still have issues in that it pastes the rows into the smaller on alternate rows.

Any ideas please?

Many thanks and kind regards

Chris
yep, the code i copied wasn't the latest one
Please change this:
Code:
Print #iFile, Join$(vY,vbcrlf)
to
Code:
Print #iFile, Join$(vY)

It will work :) And sorry for not sending it first :)
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,163
Messages
6,176,789
Members
452,743
Latest member
Unique65

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