Link to home
Start Free TrialLog in
Avatar of alines
alines

asked on

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
Avatar of Brian Withun
Brian Withun
Flag of United States of America image

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

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

Avatar of alines
alines

ASKER

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
ASKER CERTIFIED SOLUTION
Avatar of Brian Withun
Brian Withun
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
If this issue has been resolved, please close it.