Split Excel sheet into small csv files

Hi Everyone
I've just been tasked to create a macro that allows users to split a large excel sheet of around 20,000 rows into small csv files of around 100 rows.  The csv files then need to be saved to a directory. Unfortunately I don't have that much Excel VBA experience.

I would be greatful for any help
Thanks

Andrew
alinesAsked:
Who is Participating?
 
Brian WithunCommented:
Try this one:
Option Explicit
 
Const STEPSIZE As Integer = 100
 
Sub ExportChunks()
    Dim r As Long ' r = input sheet row
    Dim l As Long ' l = line # of output
    Dim f As Long ' f = field number of record
    Dim s As String ' an output record
    Dim fName As String
    Dim DestFile
    Let r = 1
    While r <= ActiveSheet.Cells(65535, "A").End(xlUp).Row
        Let fName = "C:\OUTPUT_" & Format(r, "00000") & "-" & Format(r + STEPSIZE - 1, "00000") & ".csv"
        ' Attempt to open destination file for output.
        Open fName For Output As #1
        Let l = 0
        While (l < STEPSIZE) And ((l + r) <= ActiveSheet.Cells(65535, "A").End(xlUp).Row)
            Let f = 2 ' first column is added before the loop, 2nd column and after are added in the loop
            Let s = ActiveSheet.Cells(r + l, 1).Value
            While f <= ActiveSheet.Cells(r + l, 255).End(xlToLeft).Column
                s = s & "," & ActiveSheet.Cells(r + l, f).Value
                Let f = f + 1
            Wend
            Print #1, s
            Let l = l + 1
        Wend
        Close #1
        r = r + STEPSIZE
    Wend
End Sub

Open in new window

0
 
Brian WithunCommented:
Try this.  It creates as many files as is necessary, named like:

OUTPUT_00000-00099.csv
OUTPUT_00100-00199.csv
OUTPUT_00200-00299.csv
...

Where each one contains:

"101303,Emp101303,5/3/1986,3"
"101304,Emp101304,5/11/1955,1"
"101305,Emp101305,5/8/1966,1"
"101306,Emp101306,5/3/1985,3"
...

Option Explicit
 
Const STEPSIZE As Integer = 100
 
Sub ExportChunks()
 
    Dim r As Long ' r = input sheet row
    Dim l As Long ' l = line # of output
    Dim f As Long ' f = field number of record
    Dim s As String ' an output record
    
    Dim fName As String
    Dim DestFile
    
    Let r = 0
    While r <= ActiveSheet.Cells(65535, "A").End(xlUp).Row
    
        Let fName = "C:\OUTPUT_" & Format(r, "00000") & "-" & Format(r + STEPSIZE - 1, "00000") & ".csv"
        
        ' Attempt to open destination file for output.
        Open fName For Output As #1
        
        Let l = 0
        While (l < (r + STEPSIZE - 1)) And (l <= ActiveSheet.Cells(65535, "A").End(xlUp).Row)
        
            Let f = 2
            Let s = ActiveSheet.Cells(r + l + 1, 1).Value
            
            While f <= ActiveSheet.Cells(r + l + 1, 255).End(xlToLeft).Column
            
                s = s & "," & ActiveSheet.Cells(r + l + 1, f).Value
                
                Let f = f + 1
            Wend
            
            Write #1, s
            
            Let l = l + 1
            
        Wend
        
        Close #1
            
        r = r + STEPSIZE
        
    Wend
    
End Sub

Open in new window

0
 
Brian WithunCommented:
Rather, try this one.  The solution above is quoting all the data in the CSV, which botches the import.

This version uses "Print()" rather than "Write()" and the problem goes away...


Option Explicit
 
Const STEPSIZE As Integer = 100
 
Sub ExportChunks()
    Dim r As Long ' r = input sheet row
    Dim l As Long ' l = line # of output
    Dim f As Long ' f = field number of record
    Dim s As String ' an output record
    Dim fName As String
    Dim DestFile
    Let r = 0
    While r <= ActiveSheet.Cells(65535, "A").End(xlUp).Row
        Let fName = "C:\OUTPUT_" & Format(r, "00000") & "-" & Format(r + STEPSIZE - 1, "00000") & ".csv"
        ' Attempt to open destination file for output.
        Open fName For Output As #1
        Let l = 0
        While (l < (r + STEPSIZE - 1)) And (l <= ActiveSheet.Cells(65535, "A").End(xlUp).Row)
            Let f = 2
            Let s = ActiveSheet.Cells(r + l + 1, 1).Value
            While f <= ActiveSheet.Cells(r + l + 1, 255).End(xlToLeft).Column
                s = s & "," & ActiveSheet.Cells(r + l + 1, f).Value
                Let f = f + 1
            Wend
            Print #1, s
            Let l = l + 1
        Wend
        Close #1
        r = r + STEPSIZE
    Wend
End Sub

Open in new window

0
 
alinesAuthor Commented:
Hi

Thanks for this.  Definately on the right track.

The problem I'm getting is that the second csv file has actually got two hundred rows going into it, the third 215.  Any ideas ?

Thanks

Andrew
0
 
Brian WithunCommented:
If this issue has been resolved, please close it.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.