VBA Code | Splitting up rows

[spersad]

Hello all:

I have a file with 15000 rows. I am interested in breaking this up into 500 row chunks and saving it as a .csv file. I will be loading the saved csv's to a database that can only support 500 rows at one time.

Does anyone have ideas of sample code I can use to achieve this ?

Thanks in advance for your help.


Cheers,

Leneee

 

[Ruddles]

See if this is any good - it splits up the current worksheet so don't go changing worksheets whilst it's running. Change the bits in red to suit. The only bit of code you need to write yourself is where the data is output (highlighted in blue). Shout if you need any help with it.

[FONT=Courier New][SIZE=1]Option Explicit[/SIZE][/FONT]
[FONT=Courier New][SIZE=1][/SIZE][/FONT] 
[FONT=Courier New][SIZE=1]Sub MultipleCSV_Limit()[/SIZE][/FONT]
[FONT=Courier New][SIZE=1][/SIZE][/FONT] 
[FONT=Courier New][SIZE=1]  Const sFolder As String = "[COLOR=red]C:\TEMP\[/COLOR]"   [COLOR=green] ' where CSV files will be written
[/COLOR]  Const sPrefix As String = "[COLOR=red]File_[/COLOR]"      [COLOR=green] ' root of CSV file name
[/COLOR]  Const iMaxRecords As Long = [COLOR=red]500[/COLOR]         [COLOR=green]' how many records in each CSV file
[/COLOR]  Const iPadFactor As Integer = [COLOR=red]4[/COLOR]        [COLOR=green] ' how many digits in file name serial number
[/COLOR]  Const iDataStart As Integer = [COLOR=red]1[/COLOR]         [COLOR=green]' where the data starts on the worksheet
[/COLOR]  
  Dim iLastRow As Long
  Dim iRow As Long
  Dim iSerialNo As Integer
  Dim intFH As Integer
  Dim iRecordNo As Long
  Dim sFilename As String
  Dim dtStart As Date
  
  dtStart = Now()
  iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
  iSerialNo = 0
  iRow = iDataStart
  Close[/SIZE][/FONT]

[FONT=Courier New][SIZE=1]  Do Until iRow > iLastRow
    sFilename = sFolder & sPrefix & Right(String(iPadFactor, "0") & CStr(iSerialNo), iPadFactor) & ".csv"
    intFH = FreeFile()
    Open sFilename For Output As intFH
    Do Until iRecordNo = iMaxRecords Or iRow > iLastRow
     [COLOR=blue] Print #intFH, Format(Cells(iRow, 1), "dd/mm/yyyy"); ",";[/COLOR] [COLOR=green] ' how to output a date
[/COLOR]      [COLOR=blue]Print #intFH, """"; Cells(iRow, 2); """,";[/COLOR]                [COLOR=green]' how to output a string
[/COLOR]      [COLOR=blue]Print #intFH, Cells(iRow, 3)[/COLOR]                              [COLOR=green]' how to output a number
[/COLOR]      iRecordNo = iRecordNo + 1
      iRow = iRow + 1
    Loop
    Close intFH
    iRecordNo = 0
    iSerialNo = iSerialNo + 1
  Loop[/SIZE][/FONT]
[FONT=Courier New][SIZE=1][/SIZE][/FONT] 
[FONT=Courier New][SIZE=1]  MsgBox "Done: " & CStr(iLastRow - iDataStart + 1) & " records in worksheet" & Space(15) _
      & vbCrLf & vbCrLf _
      & CStr(iSerialNo) & " file" & IIf(iSerialNo = 1, "", "s") & " created in " & sFolder & Space(15) _
      & vbCrLf & vbCrLf _
      & "Run time: " & Format(Now() - dtStart, "hh:nn:ss"), vbOKOnly + vbInformation[/SIZE][/FONT]
[FONT=Courier New][SIZE=1][/SIZE][/FONT] 
[FONT=Courier New][SIZE=1]End Sub[/SIZE][/FONT]

 

[spersad]

Hi Ruddles:

My apologies for the late reply I have been on jury duty here in the States. Thank you so much for your help. I tried your code and it worked. With a run-time of 2s! Amazing.

I do have a question. I am attaching a sample file of what I am trying to split up. I would like to include the header/row 0 in all the files I split up. I neglected to mention in my earlier post, that when I upload this information it will need the header row. Am sorry about that.

Appreciate the help if you have any ideas.

Thank you.


First Name Last Name Title Company Name Primary Contact Web Site AUM Work Email Other Email Home Phone Work Phone Mobile Phone Other Phone Work Address Line1 Work Address Line2 Work City Work State Work Region Work Postalcode Work Country Work Company Address Line1 Work Company Address Line2 Work Company City Work Company State Work Company Region Work Company Postalcode Work Company Country Other Company Address Line1 Other Company Address Line2 Other Company City Other Company State Other Company Region Other Company Postalcode Other Company Country Work Company Email Work Company Phone Other Company Email Other Company Phone Profile Category Notes

 

[Ruddles]

I'm pleased the code (almost) worked for you. Presumably you've already written the Print #intFH commands to output your data to the CSV files?

Paste this code in a new standard code module in a copy of your workbook and replace my sample Print #intFH lines with the ones you need. Check the bits of code in red and modify if necessary. Then run it.

The bits of code in blue save the column headers from the worksheet and write them to each CSV file as it's created.

[FONT=Courier New][SIZE=1]Option Explicit[/SIZE][/FONT]
[FONT=Courier New][SIZE=1][/SIZE][/FONT] 
[FONT=Courier New][SIZE=1]Sub MultipleCSV_Limit_v2()[/SIZE][/FONT]
[FONT=Courier New][SIZE=1][/SIZE][/FONT] 
[FONT=Courier New][SIZE=1]  Const sFolder As String = "[COLOR=red]C:\TEMP\[/COLOR]"    [/SIZE][/FONT][FONT=Courier New][SIZE=1][COLOR=green]' where CSV files will be written
[/COLOR]  Const sPrefix As String = "[COLOR=red]File_[/COLOR][COLOR=black]"[/COLOR]       [/SIZE][/FONT][FONT=Courier New][SIZE=1][COLOR=green]' root of CSV file name
[/COLOR]  Const iMaxRecords As Long = [COLOR=red]500[/COLOR]         [/SIZE][/FONT][FONT=Courier New][SIZE=1][COLOR=green]' how many records in each CSV file
[/COLOR]  Const iPadFactor As Integer = [COLOR=red]4[/COLOR]        [/SIZE][/FONT][FONT=Courier New][SIZE=1][COLOR=green] ' how many digits in file name serial number
[/COLOR]  Const iDataStart As Integer = [COLOR=black]2[/COLOR]         [/SIZE][/FONT][FONT=Courier New][SIZE=1][COLOR=green]' where the data starts on the worksheet
[/COLOR]  
  Dim ws As Worksheet
  Dim iLastRow As Long
  Dim iLastCol As Long
  Dim iRow As Long
  Dim iCol As Long
  Dim sColumnHeads As String
  
  Dim iSerialNo As Integer
  Dim intFH As Integer
  Dim iRecordNo As Long
  Dim sFilename As String
  
  Dim dtStart As Date
  
  dtStart = Now()
  Set ws = ThisWorkbook.Sheets("[COLOR=red]Sheet1[/COLOR]")
  iLastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
  
[/SIZE][/FONT][FONT=Courier New][SIZE=1][COLOR=blue]  If iDataStart > 1 Then
    iLastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    For iCol = 1 To iLastCol
      sColumnHeads = sColumnHeads & ",""" & ws.Cells(1, iCol) & """"
    Next iCol
    sColumnHeads = Mid(sColumnHeads, 2)
  End If
[/COLOR]  
  iSerialNo = 0
  iRow = iDataStart
  Close
  
  Do Until iRow > iLastRow
    iSerialNo = iSerialNo + 1
    sFilename = sFolder & sPrefix & Right(String(iPadFactor, "0") & CStr(iSerialNo), iPadFactor) & ".csv"
    intFH = FreeFile()
    iRecordNo = 0
    Open sFilename For Output As intFH
[/SIZE][/FONT][FONT=Courier New][SIZE=1][COLOR=blue]    If iDataStart > 1 Then
      Print #intFH, sColumnHeads
    End If
[/COLOR]    Do Until iRecordNo = iMaxRecords Or iRow > iLastRow
      Print #intFH, Format(ws.Cells(iRow, 1), "dd/mm/yyyy"); ",";  [/SIZE][/FONT][FONT=Courier New][SIZE=1][COLOR=green]' how to output a date
[/COLOR]      Print #intFH, """"; ws.Cells(iRow, 2); """,";                [/SIZE][/FONT][FONT=Courier New][SIZE=1][COLOR=green]' how to output a string
[/COLOR]      Print #intFH, ws.Cells(iRow, 3)                              [/SIZE][/FONT][FONT=Courier New][SIZE=1][COLOR=green]' how to output a number
[/COLOR]      iRecordNo = iRecordNo + 1
      iRow = iRow + 1
    Loop
    Close intFH
  Loop[/SIZE][/FONT]
[FONT=Courier New][SIZE=1][/SIZE][/FONT] 
[FONT=Courier New][SIZE=1]  MsgBox "Done: " & CStr(iLastRow - iDataStart + 1) & " records in worksheet" & Space(15) _
      & vbCrLf & vbCrLf _
      & CStr(iSerialNo) & " file" & IIf(iSerialNo = 1, "", "s") & " created in " & sFolder & Space(15) _
      & vbCrLf & vbCrLf _
      & "Run time: " & Format(Now() - dtStart, "hh:nn:ss"), vbOKOnly + vbInformation[/SIZE][/FONT]
[FONT=Courier New][SIZE=1][/SIZE][/FONT] 
[FONT=Courier New][SIZE=1]End Sub[/SIZE][/FONT]

Let me know how it goes?

 

[spersad]

Hi Ruddles:

Thank you, I did most of what you recommended with the code. I am not sure how to change the Print #intFH, sorry. All of my 22 headers are being applied when Const iDataStart As Integer = 2 vs = 1, etc...

But, I the other items in thee row post column 3 or 4 is not being appended to the CSV. Am sure its something am doing just not sure what. Sorry.

Would it be easier to email you the file?

Thank you again.

Leneee

 

[spersad]

And, sorry for all the back and forth. Am sure the code is very simple for you -- am just not very good at programming.

Thanks..

 

[Ruddles]

I've put three sample Print #intFH commands in my code. You need to replace these with 22 commands which output the type of data you're actually handling: the first 21 commands need to be terminated by semicolons indicating that there's more to come for the same line, the 22nd command should not have a semicolon at the end.

This is the way you output a date from column 1:-

Print #intFH, Format(ws.Cells(iRow, [COLOR=red][B]1[/B][/COLOR]), "dd/mm/yyyy"); "," ;

This is the way you output plain text from column 2:-

Print #intFH, """"; ws.Cells(iRow, [COLOR=blue][B]2[/B][/COLOR]); """," ;

This is the way you output a numeric value from column 3:-

Print #intFH, ws.Cells(iRow, [COLOR=magenta][B]3[/B][/COLOR]) ;

You should end up with 22 commands with the column numbers - the numbers I've coloured - going from 1 to 22.

If you still can't get it to work, let me know what type of data is in each of the 22 columns of your worksheet or post a sample of the worksheet here, and I'll write the commands for you.

 

[spersad]

Thank you Ruddles. I will try as soon I get home tonight and let you know.


Cheers,

Leneee

 

[spersad]

Hi Ruddles,

I have been away for a bit. But wanted to report that your code worked well! Thanks so much.


Cheers!

 

[Ruddles]