Concatenating lines in a text file

[thibodc]

I would like to concatenate multiple lines in a text file using Excel VBA. Concatenating will start on line two as long as line 3 is not empty. If line 3 is empty then there is no need for concatenating the file, so file is already formatted correctly. Concatenating will continue to take place until an empty line is reached. See below for an example of starting text and text after manipulation.

Starting text:

14-Sep-2019
test-00001, test-00002, test-00003, test-00
004, test-00005, test-00006, tes
t-00007, test-00008, test-00009, test
-00010, test-00011, test-00012

more text
some more text
etc

What I would like the text to look like:

14-Sep-2019
test-00001, test-00002, test-00003, test-00004, test-00005, test-00006, test-00007, test-00008, test-00009, test-00010, test-00011, test-00012

more text
some more text
etc



Thanks for the help!

[CK76]

Probably faster to just run the code without checking for 3rd line.
Something like...

Sub Demo()
Dim intFF As Integer: intFF = FreeFile()
Dim iFile As String: iFile = "C:\Test\Some.txt"
Dim rowText As String, dataStr As String
'Read from txt file and concatenate
Open iFile For Input As #intFF
Do While Not EOF(intFF)
    Line Input #intFF, rowText
    dataStr = IIf(Len(dataStr) = 0, rowText & vbNewLine, dataStr & rowText)
Loop
Close #intFF
'Write back to txt file
Open iFile For Output As #intFF
Print #intFF, dataStr
Close #intFF
End Sub

[thibodc]

Thanks for the quick response. So, the code works if I only have the concatenating lines and line 1. It seems to stop working once a new line is encountered. Suggestions?

[CK76]

Can you upload sample raw text file?

I ran test on attached and worked without issue.

Result will come out as...
14-Sep-2019
test-00001, test-00002, test-00003, test-00004, test-00005, test-00006, test-00007, test-00008, test-00009, test-00010, test-00011, test-00012

[CK76]

Oh, I see. After re-reading your initial post, I get what you mean.

Let me think on that.

Edit: Try below.

Sub Demo()
Dim intFF As Integer: intFF = FreeFile()
Dim iFile As String: iFile = "C:\Test\Sample.txt"
Dim rowText As String, dataStr As String, dataStr2 As String
Dim i As Long
'Read from txt file and concatenate
Open iFile For Input As #intFF
Do Until EOF(intFF) Or (i > 3 And Len(rowText) = 0)
    Line Input #intFF, rowText
    dataStr = IIf(Len(dataStr) = 0, rowText & vbNewLine, dataStr & rowText)
    i = i + 1
Loop
Do While Not EOF(intFF)
    Line Input #intFF, rowText
    dataStr2 = IIf(Len(dataStr2) = 0, vbNewLine & vbNewLine & rowText, dataStr2 & vbNewLine & rowText)
Loop
Close #intFF
'Write to output txt file
Open iFile For Output As #intFF
Print #intFF, dataStr & dataStr2
Close #intFF
End Sub

[thibodc]

This works great but takes a long time with larger text files...is there a way to speed things up. A 10 MB file takes about 25 minutes.

[jindon]

Try and see if this works.

Sub test()
    Dim fn As String, txt As String, a() As String, n As Long, m As Object, e
    fn = Application.GetOpenFilename("TextFiles,*.txt")
    If fn = "False" Then Exit Sub
    ReDim a(1 To 1000, 1 To 1)
    With CreateObject("VBScript.RegExp")
        .Pattern = "^(.*?[\r\n]{1,2}){2}(.*?)[\r\n]{1,2}((.+[\r\n]{1,2})+)[\r\n]+((.+([\r\n]{1,2}|$))+)"
        txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
        If .test(txt) Then
            Set m = .Execute(txt)(0).submatches
            If m(1) <> "" Then
                n = n + 1: a(n, 1) = m(1)
                n = n + 1: a(n, 1) = Replace(m(2), vbNewLine, ",")
                For Each e In Split(m(4), vbNewLine)
                    n = n + 1: a(n, 1) = e
                Next
            End If
        End If
    End With
    If n > 0 Then Sheets(1).Cells(1).Resize(n).Value = a
End Sub

[thibodc]

Thanks for the suggestion, but it doesn't seem to work....the output is incorrect. Also, I need to have the output saved to a text file and not to an Excel sheet. If you or someone else has any more suggestions it would be much appreciated. Please refer to the start of this post for sample input text and the what I would like as an output.

[jindon]

Then perhaps the structure of the text file is not correct.

[thibodc]

I see part of the problem your input file was incorrect. This is an example of what an input file looks like (see directly below):

14-Sep-2019
test-00001, test-00002, test-00003, test-00
004, test-00005, test-00006, tes
t-00007, test-00008, test-00009, test
-00010, test-00011, test-00012

more text
some more text
etc


And this is what my output needs to look like:

14-Sep-2019
test-00001, test-00002, test-00003, test-00004, test-00005, test-00006, test-00007, test-00008, test-00009, test-00010, test-00011, test-00012

more text
some more text
etc

Input files can be different...this is an example only. Basically I need all lines after line 2 to be be merged into line 2 until a empty line is encountered then rest of the text stays the same (meaning line 1 and lines including the encountered empty line through the end of the file will stay the same). Also, if line 3 happens to be empty already then the input text doesn't need to be changed at all. Thanks so much for your help. Also, could you tell me how to write the output to text. Thanks!

[jindon]

OK, see if this works,

Sub test()
    Dim fn As String, txt As String, a() As String, n As Long, m As Object, e
    fn = Application.GetOpenFilename("TextFiles,*.txt")
    If fn = "False" Then Exit Sub
    ReDim a(1 To 10000)
    With CreateObject("VBScript.RegExp")
        txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
        .Pattern = "^(.*?)[\r\n]{1,2}(.*?[\r\n]{1,2}((.*)[\r\n]{1,2})+)[\r\n]{2,}((.+([\r\n]{1,2}|$))+)"
        If .test(txt) Then
            Set m = .Execute(txt)(0).submatches
            If m(3) <> "" Then
                n = n + 1: a(n) = m(0)
                .Pattern = "[\r\n]+$"
                n = n + 1: a(n) = Replace(.Replace(m(1), ""), vbNewLine, ",")
                n=n+1
                For Each e In Split(m(4), vbNewLine)
                    n = n + 1: a(n) = e
                Next
            End If
        End If
    End With
    If n > 0 Then
        ReDim Preserve a(1 To n)
        Open Replace(fn, ".txt", "_Processed.txt") For Output As #1
            Print #1, Join(a, vbNewLine);
        Close #1
    End If
End Sub

[CK76]

Vba may not be best method then. It's limited to single thread and cannot take advantage of modern PC's cpu.

[thibodc]

Jindon I tried your suggestion, but the output is off. Here is the output:

14-Sep-2019
test-00001, test-00002, test-00003, test-00,004, test-00005, test-00006, tes,t-00007, test-00008, test-00009, test,-00010, test-00011, test-00012

more text
some more text
etc

As you can see there are some extra commas. Also, my input from my post can contain a lot more data after the test entries. Meaning the there could be hundreds of entries beyond more text, some more text, etc. When you do have extra entries all of those get concatenated also.

[jindon]

Confusing...

Can you upload 2 text files one with raw data & one with your expected result?

[thibodc]

Thanks for the info CK76. Would it speed things along if we split the file into sections (one to manipulate and one to not manipulate)? Meaning, first there would need to be a test to see where to split the file...a test to find the first blank line after the 2nd line. So, if the 3rd line is blank...no manipulation at all...the input would be the output. If the 4th line is empty then you would split the file like so: 1) First 3 lines saved to a separate file then the 3rd line would get merged into the the 2nd line 2) From the 4th line to the EOF. After this is done we would merge 1) with 2).
A similar process would be done for if a blank line wasn't found until the 5th line and so on....I wouldn't need manipulation beyond the 10th line. Is this possible?

[thibodc]

For some reason I cannot attached files. Any way, please copy and paste the following for the input (for some reason when you paste into a text editor...I found there to be an extra space on lines 2-EOF...if you find this then please delete this extra space at the beginning of each line):

14-Sep-2019
test-00001, test-00002, test-00003, test-00
004, test-00005, test-00006, tes
t-00007, test-00008, test-00009, test
-00010, test-00011, test-00012

more text
some more text
etc



Please copy and paste the following for output (for some reason when you paste into a text editor...I found there to be an extra space on lines 2-EOF...if you find this then please delete this extra space at the beginning of each line):


14-Sep-2019
test-00001, test-00002, test-00003, test-00004, test-00005, test-00006, test-00007, test-00008, test-00009, test-00010, test-00011, test-00012

more text
some more text
etc

[jindon]

Seems my code suppose to do so.
Anyway, Im out at the moment and back late.

I will upload both before/after text file when I come back.

[jindon]

OK, I see what you mean
Try change

                .Pattern = "[\r\n]+$"
                n = n + 1: a(n) = Replace(.Replace(m(1), ""), vbNewLine, ",")

to

                .Pattern = "[\r\n]+"
                .Global = True
                n = n + 1: a(n) = .Replace(m(1), "")

[CK76]

@thibodc

Let me take another look at it later. I'm bit busy today.

[CK76]

@thibodc
Try this one. Tested on approx 40Mb text file. Took about 5 sec.

Sub Demo()
Dim sFile As String: sFile = "C:\Test\Input.txt"
Dim intFF As Integer: intFF = FreeFile()
Dim fStr As String, iStr As String
Dim A, B, i As Long

Open sFile For Input As #intFF
fStr = Input(LOF(intFF), intFF)
Close #intFF

A = Split(Replace(fStr, vbCr, ""), vbLf)
B = A

For i = 0 To Application.Match("", A, 0) - 2
    iStr = IIf(Len(iStr) = 0, A(i) & vbNewLine, iStr & A(i))
    B = Filter(B, A(i), False, vbBinaryCompare)
Next

iStr = iStr & vbNewLine & Join(B, vbNewLine)
Erase B: Erase A

Open Replace(sFile, ".txt", "Out.txt") For Output As #intFF
Print #intFF, iStr
Close #intFF

End Sub

[thibodc]

Works great... thank you!