Splitting Text File based on a delimiter line

[McGibb In Aus]

Hi All,

I have a number of very large files that I need to split up based on specific delimiter lines in a given cell.
However the delimiter is not a uniform number of lines apart. The basic format of the file is:
<delimiter line>
<Name line>
<Text Line>
...
<Text Line>
<Delimiter line>

With the <Text Lines> there may be multiple text lines or just a single text line before the next delimiter line.

I need to keep a count of each delimiter occurrence. The next line after the delimiter line needs to be stored to another worksheet in column A and the delimiter occurrence number in column B.
Then all the text lines need to be saved/exported to a text using the delimiter occurence number as the filename.

By way of example, suppose this is part of the large file to split up, :

$$$

CXR-normal

CHEST

Normal heart size and mediastinal contour. The lungs and pleural spaces are clear.

$$$

Direct

Direct comparison is made with the previous study, dated [ ].

$$$

DVT

ULTRASOUND [ ] LEG DVT STUDY

CLINICAL NOTES

<colgroup><col></colgroup><tbody>
</tbody>

The delimiter line is the $$$ line, so the first occurrence would be
Saved it a secondary worksheet in cell A1 is 'CRX-Normal' and cell B1 would be simply 1
The 3 text lines would be saved to a separate text file called 1.txt
For the 2nd occurrence:
Saved in the secondary worksheet in cell A2 is 'Direct' and cell B2 would be 2
The a single text line would be saved to a separate text file called 2.txt
For the 2nd occurrence:
A3 is 'DVT' and cell B3 is 3
Then 3 text lines would be saved to 3.txt
and so on....

Hopefully this makes sense and hopefully one of you geniuses can help me out?

Regards
McGibb in Aus

 

[lrobbo314]

Give this a shot. I've added comments in the code on lines that will need to be adjusted for the file paths on your computer.

Sub SplitIt()
Dim FSO         As Object
Dim oFile       As Object
Dim FileNum     As Integer
Dim sCnt        As Long
Dim DataLine    As String
Dim SavePath    As String
Dim b           As Boolean


b = False
Set FSO = CreateObject("Scripting.FileSystemObject")
FileNum = FreeFile()
SavePath = "C:\Desktop\" 'Change to where you want files saved to
Open SavePath & "test.txt" For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL]  'This is opening from desktop and using the SavePath variable.  Change if your file is not on the Desktop


While Not EOF(FileNum)
    Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL] , DataLine
        If b = True Then
            Set oFile = FSO.CreateTextFile(SavePath & sCnt & ".txt")
            oFile.WriteLine DataLine
            oFile.Close
            Set oFile = Nothing
            Range("A" & sCnt).Value = DataLine
            Range("B" & sCnt).Value = sCnt
            b = False
        End If
        
        If DataLine = "$$$" Then
            sCnt = sCnt + 1
            b = True
        End If
Wend
End Sub

 

[lrobbo314]

I refactored the code a bit. This version prompts the user to select the text file to be read as well as the folder where the results are going to be saved.

Sub SplitItII()
Dim FSO         As Object
Dim oFile       As Object
Dim FileNum     As Integer
Dim sCnt        As Long
Dim DataLine    As String
Dim SavePath    As String
Dim tFile       As String


tFile = DLG(msoFileDialogFilePicker, "Select text file to read", "*.txt; *.csv")
SavePath = DLG(msoFileDialogFolderPicker, "Select folder destination to save files")


Set FSO = CreateObject("Scripting.FileSystemObject")
FileNum = FreeFile()
Open tFile For Input As [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum"]#FileNum[/URL] 


While Not EOF(FileNum)
    Line Input [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum"]#FileNum[/URL] , DataLine
        If DataLine = "$$$" Then
            sCnt = sCnt + 1
            Line Input [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum"]#FileNum[/URL] , DataLine
            Set oFile = FSO.CreateTextFile(SavePath & "" & sCnt & ".txt")
            oFile.WriteLine DataLine
            oFile.Close
            Set oFile = Nothing
            Range("A" & sCnt).Value = DataLine
            Range("B" & sCnt).Value = sCnt
        End If
Wend


End Sub


Function DLG(fType As Integer, Title As String, Optional Filters As String) As String
Dim fDlg As FileDialog


Set fDlg = Application.FileDialog(fType)


With fDlg
    .AllowMultiSelect = False
    .InitialFileName = Environ("UserProfile")
    .Title = Title
    If Filters <> vbNullString Then .Filters.Add "Text Files", "*.txt; *.csv"
    .Show
End With


DLG = fDlg.SelectedItems(1)
End Function

 

[lrobbo314]

Noticed something that needed to be fixed. This should do it.

Sub SplitItII()
Dim FSO         As Object
Dim oFile       As Object
Dim FileNum     As Integer
Dim sCnt        As Long
Dim DataLine    As String
Dim SavePath    As String
Dim tFile       As String


tFile = DLG(msoFileDialogFilePicker, "Select text file to read", "*.txt; *.csv")
SavePath = DLG(msoFileDialogFolderPicker, "Select folder destination to save files")


Set FSO = CreateObject("Scripting.FileSystemObject")
FileNum = FreeFile()
Open tFile For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL] 


While Not EOF(FileNum)
    Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL] , DataLine
        If DataLine = "$$$" Then
            sCnt = sCnt + 1
            Do
                Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL] , DataLine
            Loop Until DataLine <> vbNullString
            Set oFile = FSO.CreateTextFile(SavePath & "" & sCnt & ".txt")
            oFile.WriteLine DataLine
            oFile.Close
            Set oFile = Nothing
            Range("A" & sCnt).Value = DataLine
            Range("B" & sCnt).Value = sCnt
        End If
Wend


End Sub


Function DLG(fType As Integer, Title As String, Optional Filters As String) As String
Dim fDlg As FileDialog


Set fDlg = Application.FileDialog(fType)


With fDlg
    .AllowMultiSelect = False
    .InitialFileName = Environ("UserProfile")
    .Title = Title
    If Filters <> vbNullString Then .Filters.Add "Text Files", "*.txt; *.csv"
    .Show
End With


DLG = fDlg.SelectedItems(1)
End Function

 

[McGibb In Aus]

Hi lrobbo314,

Thank you so much for your help.
Unfortunately the ... in post was a critical piece of the puzzle, not sure why it didn't show in the post.
Anyway what you gave me was 75% of what I needed and I have since worked out the rest. But the structure you gave we was invaluable so thank you very much.
The prompt replies were much appreciated.

Regards
McGibb In Aus

 

[lrobbo314]

Great! Glad it got you going in the right direction.