Parse rows to files, 1 row per file...

[spacely]

Hi there,

I need to pull off rows of numbers, one row at a time, into one unique file name at a time. Each file would have the same couple-line header. All this is in excel starting in column A. Each value is in a cell. They're all real values. Each uniqueName file would be stored in the current folder. Column B would be ignorSo (sorry for the messy format paste):

uniqueName1 ignore -834.6 112.9 156.7 2280.7 376.0 1825.6
uniqueName2 ignore 903.9 -13.1 94.9 -280.9 -358.0 1416.1
uniqueName3 ignore 99.3 -823.8 307.6 618.4 2504.2 2468.6
uniqueName4 ignore 17.8 881.1 96.2 1856.6 -2654.3 -22.7
uniqueName5 ignore 411.0 476.0 -284.2 843.5 502.2 -965.9
uniqueName6 ignore 191.3 707.8 597.2 -446.0 -667.2 2316.2
uniqueName7 ignore -462.0 306.5 57.0 -4823.3 -2045.2 15.4
uniqueName8 ignore -169.3 -659.8 241.5 4385.2 -1286.1 2360.4
uniqueName9 ignore -478.9 -390.4 56.5 856.6 -7230.6 1764.7
uniqueName10 ignore 203.5 455.2 134.9 -2254.1 5008.6 1908.2
uniqueName11 ignore 822.8 41.5 80.2 -155.4 -66.8 -2415.9
uniqueName12 ignore 673.8 -274.8 399.5 -36.2 -827.9 3535.6
uniqueName13 ignore -14.4 -320.0 34.5 162.5 853.0 -372.3
uniqueName14 ignore 903.9 -13.1 94.9 -280.9 -358.0 1416.1
uniqueName15 ignore 595.9 -207.1 32.6 -0.9 0.4 -20.8
uniqueName16 ignore -478.9 -390.4 56.5 856.6 -7230.6 1764.7


So uniqueName1.txt would look like:

General Title Line

time 251 252 253 254 255 256
T FxR0 FyR0 FzR0 MxR0 MyR0 MzR0
[sec] [kN] [kN] [kN] [kNm] [kNm] [kNm]

1 -834.6 112.9 156.7 2280.7 376.0 1825.6

So there's a 1 prefixing the line where that is the file number. I think the best way to for-next it is to highlight the filenames in column A and for the selection just use a loop counter to store each line to each file and the loop counter would be that number prefixing each line.

Let me know if any info is missing, and thanks a lot!

 

[ask2tsp]

I created a workbook with two sheets labeled data and headers
please note that i changed decimal point to a comma because I use the Dutch excel.

data

*	A	B	C	D	E	F	G	H
1	uniqueName1	*	-834,6	112,9	156,7	2280,7	376	1825,6
2	uniqueName2	*	903,9	-13,1	94,9	-280,9	-358	1416,1
3	uniqueName3	*	99,3	-823,8	307,6	618,4	2504,2	2468,6
4	uniqueName4	*	17,8	881,1	96,2	1856,6	-2654,3	-22,7
5	uniqueName5	*	411	476	-284,2	843,5	502,2	-965,9
6	uniqueName6	*	191,3	707,8	597,2	-446	-667,2	2316,2
7	uniqueName7	*	-462	306,5	57	-4823,3	-2045,2	15,4
8	uniqueName8	*	-169,3	-659,8	241,5	4385,2	-1286,1	2360,4
9	uniqueName9	*	-478,9	-390,4	56,5	856,6	-7230,6	1764,7
10	uniqueName10	*	203,5	455,2	134,9	-2254,1	5008,6	1908,2
11	uniqueName11	*	822,8	41,5	80,2	-155,4	-66,8	-2415,9
12	uniqueName12	*	673,8	-274,8	399,5	-36,2	-827,9	3535,6
13	uniqueName13	*	-14,4	-320	34,5	162,5	853	-372,3
14	uniqueName14	*	903,9	-13,1	94,9	-280,9	-358	1416,1
15	uniqueName15	*	595,9	-207,1	32,6	-0,9	0,4	-20,8
16	uniqueName16	*	-478,9	-390,4	56,5	856,6	-7230,6	1764,7

<colgroup><col style="width:30px; "><col style="width:108.67px;"><col style="width:22.67px;"><col style="width:69.33px;"><col style="width:69.33px;"><col style="width:69.33px;"><col style="width:69.33px;"><col style="width:69.33px;"><col style="width:69.33px;"></colgroup><tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4


headers

*	A	B	C	D	E	F	G
1	time	251	252	253	254	255	256
2	T	FxR0	FyR0	FzR0	MxR0	MyR0	MzR0
3	[sec]	[kN]	[kN]	[kN]	[kNm]	[kNm]	[kNm]

<colgroup><col style="width:30px; "><col style="width:69.33px;"><col style="width:69.33px;"><col style="width:69.33px;"><col style="width:69.33px;"><col style="width:69.33px;"><col style="width:69.33px;"><col style="width:69.33px;"></colgroup><tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4


Q


the following code creates the txt files in the same folder as this workbook

Option Explicit

Sub rowsToFiles()
   'mrExcel forum thread 1008789
   
   Dim fso        As Object
   Dim txtFile    As Scripting.file
   Dim txtStream  As TextStream
   
   Dim shtData    As Worksheeta
   Dim dataRow    As Long
   Dim dataAsText As String
   Dim fileName   As String
   Dim headers    As Range
   Dim hdrAr()    As Variant
   Dim hdrRow(1 To 3)  As String
   Dim i       As Long
   Dim nr      As Integer
   Dim arCol   As Integer
   
   Set fso = CreateObject("Scripting.FileSystemObject")
   
   Set shtData = ThisWorkbook.Worksheets("data")
   Set headers = ThisWorkbook.Worksheets("headers").Range("titles")
   hdrAr = headers
   
   For i = 1 To 3
      For arCol = 1 To UBound(hdrAr, 2)
         hdrRow(i) = hdrRow(i) & " " & hdrAr(i, arCol)
      Next arCol
      hdrRow(i) = Mid(hdrRow(i), 2)
   Next i
   
   For dataRow = 1 To shtData.Range("A1").End(xlDown).Row
      fileName = Cells(dataRow, 1).Value
      '----- extract nr at the end of the file name
      i = Len(fileName)
      While Mid(fileName, i, 1) >= "0" And Mid(fileName, i, 1) <= "9"
         i = i - 1
      Wend
      nr = Mid(fileName, i + 1)
      '-----
      'create file in folder of this workbook
      fileName = ThisWorkbook.Path & "\" & fileName & ".txt"
      
      Set txtStream = fso.CreateTextFile(fileName, True) 'ok to overwrite
      'write headers
      For i = 1 To 3
         txtStream.WriteLine hdrRow(i)
      Next i
      '----- write data prefixed by file nr
      dataAsText = shtData.Cells(dataRow, 3)
      For i = 4 To 8
         dataAsText = dataAsText & " " & shtData.Cells(dataRow, i)
      Next i
      txtStream.WriteLine nr & " " & dataAsText
      '-----
      txtStream.Close
   Next dataRow
End Sub

 

[spacely]

It cannot find

Dim txtStream As TextStream
seems TextStream isn't showing up as a possible thing to dimension... ?

 

[spacely]

OK, changing it to

Dim txtStream As Object

works.

Thanks.

 

[spacely]

Oops, only the 1st 3 lines of the header are getting written to each file...

 

[spacely]

...and I see you hardcoded header rows read to 3. I changed to 6 and it works as I need.

 

[ask2tsp]

All issues solved now?

 

[spacely]

All issues solved. Thanks for helping