Results 1 to 3 of 3
  1. #1
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts

    VB or macro needed to grab N rows from a CSV file and move to a new file.

    Could someone provide VB code that would allow me to specify N-rows of a large CSV file that need to be copied and then pasted to set of new (smaller) CSV files?

    e.g., if I have a 22,000 row CSV file, I'd like to run something that might be:

    SPLIT 5000 and have the code create 5 new CSV files (could be numbered 1-5) that would have blocks of 5000 rows in each (namely, 1-5000 in the first; 5001-10000 in the second; etc., with the balance in the last)

  2. #2
    2 Star Lounger
    Join Date
    Mar 2010
    Location
    Tampa, FL, USA
    Posts
    114
    Thanks
    11
    Thanked 10 Times in 9 Posts
    Record a macro of you performing the steps as you described above exactly, including opening the CSV file if it's always the same file. Read a few references about looping in VBA to get the macro to continue until all the lines are copied, then post your code if you have problems.
    PJ in FL

  3. #3
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    Hi kweaver,

    try:
    Code:
    Sub TextFileSplit()
    'Set Up Variables
    Dim StrLineIn As String, StrFlNm As String, StrHead As String, StrOut As String, StrFlOut As String
    Dim iFileIn As Long, Counter As Long, iSplit As Long, iFileOut As Long
    'Get Input FileName
    StrFlNm = Application.GetOpenFilename(filefilter:="Text Files(*.txt;*.csv),*.txt;*.csv,All Files (*.*),*.*")
    If Error <> "" Then GoTo Errhandler
    'Turn Screen Updating Off
    Application.ScreenUpdating = False
    'Get Next Available File Handle Number
    iFileIn = FreeFile()
    'Open Text File For Input
    Open StrFlNm For Input As #iFileIn
    'Set the record counter
    Counter = 0
    'Number of records per file
    iSplit = 5000
    'Initialize the output file counter
    iFileOut = 1
    Line Input #1, StrHead
    'Loop Until the End Of The Import File Is Reached
    Do While Seek(iFileIn) <= LOF(iFileIn)
      Line Input #iFileIn, StrLineIn
      'Add the current record
      StrOut = StrOut & StrLineIn & vbCr
      'Display Importing Row Number On Status Bar
      Application.StatusBar = "Processing File: " & iFileOut & ", Row: " & Counter
      'Increment the Counter By 1
      Counter = Counter + 1
      If Counter Mod iSplit = 0 Then
        'Create the output filename
        StrFlOut = Split(StrFlNm, ".")(0) & Format(iFileOut, "00") & "." & Split(StrFlNm, ".")(1)
        'Add the Header
        StrOut = StrHead & vbCr & StrOut
        'Create the output file
        Call WriteFile(StrOut, StrFlOut)
        iFileOut = iFileOut + 1
        StrOut = ""
      End If
    Loop
    'Write out any remaining records
    If Counter Mod iSplit <> 0 Then
      'Create the output filename
      StrFlOut = Split(StrFlNm, ".")(0) & Format(iFileOut, "00") & "." & Split(StrFlNm, ".")(1)
      'Add the Header
      StrOut = StrHead & vbCr & StrOut
      'Create the output file
      Call WriteFile(StrOut, StrFlOut)
    End If
    'Finished, so close the source file
    Close
    'Remove Message From Status Bar
    Application.StatusBar = False
    'Turn Screen Updating On
    Application.ScreenUpdating = True
    Exit Sub
    Errhandler:
    MsgBox "No file Selected!"
    End Sub
    
    Sub WriteFile(StrData As String, StrFlOut As String)
    Dim iFileOut As Long
    'Get Next Available File Handle Number
    iFileOut = FreeFile()
    'Create the file
    Open StrFlOut For Output As #iFileOut
    'Output the data
    Print #iFileOut, StrData
    'Close the file
    Close #iFileOut
    End Sub
    Note: The above code assumes your input file has a header row (that being the first line). That line is captured and written to each of the output files.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •