Macro that Splits columns and creates .txt files with the data

[Zlerp]

Hello All!

I am looking for help in creating a macro that will split my data into X number of groups and output X text files that will contain the data. I want a prompt to appear when i run the macro that will let me choose how many times i want to evenly split the data. I also want another Prompt that will let me put in the File directory that will create folders and place the .txt into the correct folder.

For Example:

In column A I have 30 rows of data. When i click run, a prompt appears asking me how many times I would like to split the data. I choose 5. Then another prompt appears asking me where i wouild like to save these, I copy and paste a path into it.

Then it will split the 30 rows of data 5 times, meaning A1-A6 will be 1.txt and placed in a folder named 1, A7-A12 will be 2.txt and placed in a folder named 2, A13-A18 will be 3.txt and placed in a folder named 3, A19-A24 will be 4.txt and placed in a folder named 4.....and so on and so forth until its finished. These Foldwers will be saved into the file location I copy and paste into the 2nd prompt.

So In the specified file location I copy and paste I should have 5 folders labeled 1-5 with a corresponding text file in each folder. Each Text file should contain 6 lines of data (A1-A6)

Please let me know if you have any questions or dont understand what I am asking. I could try and post a better example.

THANKS FOR ALL YOUR HELP!!!!!

[westconn1]

you can test like

nofiles = InputBox("enter number of files", , 5)
If nofiles < 1 Then Exit Sub
dest = InputBox("Enter destination folder", , "c:\temp")
' better to use a folder picker
If Not Right(dest, 1) = "\" Then dest = dest & "\"
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
firstrow = 1 ' change to suit
norows = (lastrow - firstrow) \ (nofiles - 1)
nocols = Cells(1, Columns.Count).End(xlToLeft).Column
For fil = firstrow To lastrow Step norows
myarr = Range(Cells(fil, 1), Cells(fil + norows - 1, nocols))
For rw = 1 To UBound(myarr, 1)
For col = 1 To UBound(myarr, 2)
mystr = mystr & myarr(rw, col) & vbTab
Next
mystr = mystr & vbNewLine
Next

f = FreeFile
Open dest & fil \ norows + 1 & ".txt" For Output As f
Print #1, mystr
Close f
cnt = cnt + 1
mystr = vbNullString
Next

[snb]

Sub M_snb()
With Application.FileDialog(4)
.Show
c00 = .SelectedItems(1)
End With

y = Cells(Rows.Count, 1).End(xlUp).Row
x = InputBox("number", "snb")

With CreateObject("scripting.filesystemobject")
For j = 0 To x - 1
.createtextfile(c00 & "\" & j +1 & ".txt").write Join(Application.Transpose(Cells(1, 1).Offset((y \ x) * j).Resize(y \ x)), vbCrLf)
Next
End With
End Sub

[Zlerp]

Sub M_snb()
With Application.FileDialog(4)
.Show
c00 = .SelectedItems(1)
End With

y = Cells(Rows.Count, 1).End(xlUp).Row
x = InputBox("number", "snb")

With CreateObject("scripting.filesystemobject")
For j = 0 To x - 1
.createtextfile(c00 & "\" & j +1 & ".txt").write Join(Application.Transpose(Cells(1, 1).Offset((y \ x) * j).Resize(y \ x)), vbCrLf)
Next
End With
End Sub


Hey thanks for the help, this code seems to work great. but would it be possible to change a few things around like creating a folder for each .txt file inside my chosen File Directory. Also, if there isnt an even split to put the extra lines of data in the last file.

For Example:
If column A has 31 rows of values and i choose to split it 6 times. Then the 6th file should contain 6 lines of data.

Once again thanks for your help.

[snb]

Yes, no problem if you use mkdir en save the last ones in

c00 & "\" & j +1 & ".txt"

[Zlerp]

Yes, no problem if you use mkdir en save the last ones in

c00 & "\" & j +1 & ".txt"

Ok thanks for the tip, but as i am a novice i am not sure where i would add that into the code. Could you please explain a little more.

Sorry for asking.