save one large file as separate text files

[cmccabe1]

I have a file of 1,000 records all in the same format as the attached file. In column A there is text and in column B there is a unique #. What I am trying to do is save each of the 1,000 records as a separate text file using the text_unique # as the text filename. Each file would contain all the entries (except for the last column - Classification) until the next file was saved. Thank you .


Desired output:

first text file (LastName,FirstName_0)
Chr  Start   End   Ref   Alt

Second text file (xxxx,xxx_1111111)
Chr  Start   End   Ref   Alt

Third text file (xxxx,xxx_2222222)
Chr  Start   End   Ref   Alt

[p45cal]

Confusing.
1. You have a sheet Desired, how does this relate to Desired output above? What is Chr Start End Ref Alt?
2. Be specific as to where text_unique # is (is it really in column B?)
3. May not be relevant, but row 6 of the Desired sheet contains #Sample, but the cell to iuts left starts Barcode (even the 000000000000_Block0 doesn't help because I can't match it up with anything on the Name sheet).

You want a computer to do stuff for you but you're very fuzzy when describing what you want it to do.

[cmccabe1]

I apologize for the confusion. I attached the wrong work book and attached is the correct one, I hope it helps.

1. [QUOTE]What is Chr Start End Ref Alt[/QUOTE] refers to columns C,D,E,F,G and column H (Classification) is removed from the new text file.

2.

Be specific as to where text_unique # is

column A is text a "_" is the separator and column B is the unique # an example would be
columnA columnB
LastName,FirstName_0

3. I posted the wrong attachment and the correct one is more clear I hope.



Thank you very much .

[p45cal]

try running this when the all sheet is the active sheet:

blah()
Set SourceSht = ActiveSheet
Set newsht = Worksheets.Add
newsht.Move
Set newsht = ActiveSheet
With newsht
  For Each are In SourceSht.Columns("A:A").SpecialCells(xlCellTypeBlanks).Areas
    .Cells.Clear
    .Range("A1").Resize(are.Rows.Count, 5) = are.Offset(, 2).Resize(, 5).Value
    .SaveAs ThisWorkbook.Path & "\" & are.Cells(1).Offset(-1) & "-" & are.Cells(1).Offset(-1, 1) & ".txt", xlCSV
  Next are
  newsht.Parent.Close False
End With
End Sub

The files are saved in the same folder as the file with the code in. Currently saves as csv files.
To save as tab delimited you could try changing xlCSV to xlUnicodeText or xlTextWindows or xlTextMSDOS

The code depends on the cells between entries in column A being completely blank cells (.SpecialCells(xlCellTypeBlanks))

[cmccabe1]

Thank you very much it works great.... I will add to you rep this afternoon as I get an error when I do (You have given out too much Reputation in the last 24 hours, try again later). Thank you .

[snb]

Sub M_snb()
   With CreateObject("scripting.filesystemobject")
        For Each ar In Sheet1.Columns(1).SpecialCells(4).Areas
            sn = ar.Offset(, 2).Resize(, 5)
            For j = 1 To UBound(sn)
               c00 = c00 & vbLf & Join(Application.Index(sn, j), ",")
            Next
            .createtextfile(ThisWorkbook.Path & "\" & Replace(ar.Cells(1).Offset(-1), ",", "_") & "_" & ar.Cells(1).Offset(-1, 1) & ".csv").write Mid(c00, 2)
            c00 = ""
        Next
    End With
End Sub

[cmccabe1]

Thank you @snb