Split spreadsheet data into tab delimited text files

[AntonyMoe]

Hello guys!

I'm new in VBA and I need you help.

I need to save data from excel to txt files.
I found a code that save data to "xlsx" format, but I need to save to "txt" tab delimited text.

When I switch ".xlsx" to ".txt" in the code, the saved files came out like they're corrupted.

Thank you in advance

Sub ExtractToNewWorkbook()

Dim ws     As Worksheet


Dim wsNew  As Workbook


Dim rData  As Range


Dim rfl    As Range


Dim state  As String


Dim sfilename As String


Set ws = ThisWorkbook.Sheets("emp")


'Apply advance filter in your sheet


With ws


Set rData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 11).End(xlUp))


.Columns(.Columns.Count).Clear


.Range(.Cells(2, 6), .Cells(.Rows.Count, 6).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True


 
For Each rfl In .Range(.Cells(1, .Columns.Count), .Cells(.Rows.Count, .Columns.Count).End(xlUp))


state = rfl.Text


 


Set wsNew = Workbooks.Add


sfilename = state & ".xlsx"


'Set the Location


ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sfilename


Application.DisplayAlerts = False


ws.Activate


rData.AutoFilter Field:=6, Criteria1:=state


rData.Copy


Windows(state).Activate


ActiveSheet.Paste


ActiveWorkbook.Close SaveChanges:=True


Next rfl


Application.DisplayAlerts = True


End With


ws.Columns(Columns.Count).ClearContents


rData.AutoFilter


End Sub

 

[Joe4]

Welcome to the Board!

Just turn on your Macro Recorder, and record yourself saving the file as the "Tab (Text delimited) (*.txt)" SaveAs Type, and you should have the code that you need to save to a tab-delimited file.

 

[AntonyMoe]

Thank for your reply Joe4!
I apologize but I didn't explain myself well.

I need to split the spreadsheet data into multiple text files (tab text delimited).
The code I found does it (almost), but splits it into "xlsx" formatted files and I need it to be in "txt".

What do I need to change in this code to splits data into multiple text files?


Thank you in advance

 

[Joe4]

If you use the Macro Recorder, you can see wha the Save statement needs to look like, then make the corresponding changes in your code.

So, first, you would want to change this line:

sfilename = state & ".xlsx"

to:

sfilename = state & ".txt"

and then change this line:

ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sfilename

to this:

ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & sfilename, _
        FileFormat:=xlUnicodeText, CreateBackup:=False

 

[AntonyMoe]

Hello Joe4,

when I run the code it return the message:

Run-time error '1004' - Cannot access read-only document.

 

[Joe4]

I would need to try to recreate your scenario to test it all out.
What exactly does your data look like?

You cannot upload files to this site. But there are tools you can use to post screen images. They are listed in Section B of this link here: http://www.mrexcel.com/forum/board-a...forum-use.html.
Also, there is a Test Here forum on this board that you can use to test out these tools to make sure they are working correctly before using them in your question.

 

[AntonyMoe]

Hello Joe4,

Here is my data:

name	age	phone	ID	adress	state
Cecilia Chapman	23	778-098-776	987	711-2880 Nothing St.	NY
Iris Watson	34	119-453-786	44321	Frederick Nebraska 20620	NV
Celeste SLATER	33	(793) 151-6230	834	Azusa New York 39531	NY
Theodore Lowe	56	(654) 393-5734	11254	7292. It was said Ai.	AS
Calista Wise,	32	(404) 960-3807	532	Corona New Mexico 08219	NM
Forrest Ray	61	(314) 244-6306	123009	P.O. Box 929 4189 Nunc Road	KY

<tbody>
</tbody>

- Sheet name is: emp
- Software: Microsoft Excel v16.21 2018 mac
- Error message:Run-time error '1004' - Cannot access read-only document 'NY.txt'

Sub ExtractToNewWorkbook()

Dim ws     As Worksheet




Dim wsNew  As Workbook




Dim rData  As Range




Dim rfl    As Range




Dim state  As String




Dim sfilename As String




Set ws = ThisWorkbook.Sheets("emp")




'Apply advance filter in your sheet




With ws




Set rData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 11).End(xlUp))




.Columns(.Columns.Count).Clear




.Range(.Cells(2, 6), .Cells(.Rows.Count, 6).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True




 
For Each rfl In .Range(.Cells(1, .Columns.Count), .Cells(.Rows.Count, .Columns.Count).End(xlUp))




state = rfl.Text




 




Set wsNew = Workbooks.Add




sfilename = state & ".txt"




'Set the Location




ActiveWorkbook.SaveAs FileName:=ThisWorkbook.Path & "/" & sfilename, _
        FileFormat:=xlUnicodeText, CreateBackup:=False




Application.DisplayAlerts = False




ws.Activate




rData.AutoFilter Field:=6, Criteria1:=state




rData.Copy




Windows(state).Activate




ActiveSheet.Paste




ActiveWorkbook.Close SaveChanges:=True




Next rfl




Application.DisplayAlerts = True




End With




ws.Columns(Columns.Count).ClearContents




rData.AutoFilter




End Sub

Thank you in advance

 

[Joe4]

- Software: Microsoft Excel v16.21 2018 mac
- Error message:Run-time error '1004' - Cannot access read-only document 'NY.txt'

Firstly, always be sure to mention if you are using a Mac version of Excel, they do not always behave the same.

Seeing your data, your issue is now more clear. You are naming the file using the State fields. But note that you have two records where the state is "NY".
So, at best, your second one would overwrite your first (which I don't think is what you want). However, it must think that the first one is still open, so you will encounter that kind of error when you try to save a file to a name of another file that is already open.