Remove empty rows from .txt file

[margentieri]

Hello all,

I have created a VBA script that pulls data from one document, and exports that data into several different files. There is a blank row in my data (which I want to keep, row 17, i.e. the blank row in between the "Quad#" values and the PlateData value), but instead of showing up in the text file as an empty row (i.e. just a carriage return on that line, nothing else), it appears as a line with 24 tabs, corresponding to the 24 columns of data. How can I modify my code so that this empty row is actually empty, instead of populated with tabs? Thanks!

Sub Split1536Loop()

Dim Wb As Workbook
Dim OutoutFile As Variant
Dim FileNameExt As Variant
Dim FileNameNoExt As String
Dim OutputFile As Variant
Dim Quad1 As Variant
Dim Quad2 As Variant
Dim Quad3 As Variant
Dim Quad4 As Variant
Dim PlateData As Variant

FileNameExt = Application.GetOpenFilename(FileFilter:="Text Files (*.txt; *.csv), *.txt; *.csv", Title:="Please select a file")
If FileNameExt = False Then
    MsgBox "Operation Cancelled", vbOKOnly
    Exit Sub
End If

FileNameNoExt = Left(FileNameExt, Len(FileNameExt) - 4)


Application.ScreenUpdating = False
Application.DisplayAlerts = False


Set Wb = Workbooks.Open(FileNameExt)
    
Quad1 = Range(Cells(1, 1), Cells(16, 24)).Value
Quad2 = Range(Cells(1, 25), Cells(16, 48)).Value
Quad3 = Range(Cells(17, 1), Cells(32, 24)).Value
Quad4 = Range(Cells(17, 25), Cells(32, 48)).Value
PlateData = Range(Cells(34, 1), Cells(36, 12)).Value


For i = 1 To 4
    Set OutputFile = Workbooks.Add
    OutputFile.Windows(1).Visible = False
    OutputFile.Activate
    
    If i = 1 Then
        Range(Cells(1, 1), Cells(16, 24)) = Quad1
        Range(Cells(18, 1), Cells(20, 12)) = PlateData
    ElseIf i = 2 Then
        Range(Cells(1, 1), Cells(16, 24)) = Quad2
        Range(Cells(18, 1), Cells(20, 12)) = PlateData
    ElseIf i = 3 Then
        Range(Cells(1, 1), Cells(16, 24)) = Quad3
        Range(Cells(18, 1), Cells(20, 12)) = PlateData
    ElseIf i = 4 Then
        Range(Cells(1, 1), Cells(16, 24)) = Quad4
        Range(Cells(18, 1), Cells(20, 12)) = PlateData
    End If

    OutputFile.SaveAs Filename:=FileNameNoExt & "_Quad" & i & ".txt", FileFormat:=42
    OutputFile.Close

Next i

Wb.Close

ThisWorkbook.Activate
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

I tried to include examples of my data, but this forum seems to be automatically deleting the tabs from the line in question, so it's rather moot to paste it here if it does not show the problem. Happy to answer any questions or send example data files. Thanks!

 

[John_w]

A different approach is needed - use FileSystemObject to create the text files from the arrays.

Sub Split1536Loop()

    Dim Wb As Workbook
    Dim FileNameExt As Variant
    Dim FileNameNoExt As String
    Dim Quad(1 To 4) As Variant
    Dim PlateData As Variant
    Dim i As Long
    Dim lines() As String, q As Long, r As Long
    Dim FSO As FileSystemObject
    Dim ts As TextStream
   
    FileNameExt = Application.GetOpenFilename(FileFilter:="Text Files (*.txt; *.csv), *.txt; *.csv", Title:="Please select a file")
    If FileNameExt = False Then
        MsgBox "Operation Cancelled", vbOKOnly
        Exit Sub
    End If
    
    FileNameNoExt = Left(FileNameExt, Len(FileNameExt) - 4)
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set Wb = Workbooks.Open(FileNameExt)
        
    Quad(1) = Range(Cells(1, 1), Cells(16, 24)).Value
    Quad(2) = Range(Cells(1, 25), Cells(16, 48)).Value
    Quad(3) = Range(Cells(17, 1), Cells(32, 24)).Value
    Quad(4) = Range(Cells(17, 25), Cells(32, 48)).Value
    PlateData = Range(Cells(34, 1), Cells(36, 12)).Value
    
    Wb.Close
    
    ThisWorkbook.Activate
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    For q = 1 To 4
    
        Set ts = FSO.CreateTextFile(FileNameNoExt & "_Quad" & q & ".txt")
        
        ReDim lines(1 To UBound(Quad(q)) + 1 + UBound(PlateData))
        
        r = 0
        For i = 1 To UBound(Quad(q))
            r = r + 1
            lines(r) = Join(Application.Index(Quad(q), i, 0), vbTab)
        Next
        
        'Blank line
        r = r + 1
        lines(r) = ""
        
        For i = 1 To UBound(PlateData)
            r = r + 1
            lines(r) = Join(Application.Index(PlateData, i, 0), vbTab)
        Next
        
        ts.Write Join(lines, vbCrLf)
        ts.Close
        
    Next
    
End Sub

FileSystemObject could also read the source data 'silently', instead of Workbooks.Open, however I've kept that part of the code similar to yours.

 

[margentieri]

Thanks! I'll give this a try

 

[margentieri]

A different approach is needed - use FileSystemObject to create the text files from the arrays.

Sub Split1536Loop()

    Dim Wb As Workbook
    Dim FileNameExt As Variant
    Dim FileNameNoExt As String
    Dim Quad(1 To 4) As Variant
    Dim PlateData As Variant
    Dim i As Long
    Dim lines() As String, q As Long, r As Long
    Dim FSO As FileSystemObject
    Dim ts As TextStream
   
    FileNameExt = Application.GetOpenFilename(FileFilter:="Text Files (*.txt; *.csv), *.txt; *.csv", Title:="Please select a file")
    If FileNameExt = False Then
        MsgBox "Operation Cancelled", vbOKOnly
        Exit Sub
    End If
    
    FileNameNoExt = Left(FileNameExt, Len(FileNameExt) - 4)
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set Wb = Workbooks.Open(FileNameExt)
        
    Quad(1) = Range(Cells(1, 1), Cells(16, 24)).Value
    Quad(2) = Range(Cells(1, 25), Cells(16, 48)).Value
    Quad(3) = Range(Cells(17, 1), Cells(32, 24)).Value
    Quad(4) = Range(Cells(17, 25), Cells(32, 48)).Value
    PlateData = Range(Cells(34, 1), Cells(36, 12)).Value
    
    Wb.Close
    
    ThisWorkbook.Activate
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    For q = 1 To 4
    
        Set ts = FSO.CreateTextFile(FileNameNoExt & "_Quad" & q & ".txt")
        
        ReDim lines(1 To UBound(Quad(q)) + 1 + UBound(PlateData))
        
        r = 0
        For i = 1 To UBound(Quad(q))
            r = r + 1
            lines(r) = Join(Application.Index(Quad(q), i, 0), vbTab)
        Next
        
        'Blank line
        r = r + 1
        lines(r) = ""
        
        For i = 1 To UBound(PlateData)
            r = r + 1
            lines(r) = Join(Application.Index(PlateData, i, 0), vbTab)
        Next
        
        ts.Write Join(lines, vbCrLf)
        ts.Close
        
    Next
    
End Sub

FileSystemObject could also read the source data 'silently', instead of Workbooks.Open, however I've kept that part of the code similar to yours.

So this worked really well!!! Did exactly what I needed. The only issue was in defining ts as TextStream. This is not a valid data type, but rather an object from what I can tell. I changed the line "Dim ts as TextStream" to "Dim ts as Object" and that seemed to fix it. Same with defining FSO as FileSystemObject.

I am curious about using FileSystemObject to read the data source silently though. Any input you might have on how I can go about that would be appreciated. I am not very familiar with working with FSO... still kinda new to all this. Thanks again!

 

[John_w]

You're correct about changing those two variables to Object to fix the errors. I inadvertently left them as early-bound data types, which require a reference to MS Scripting Runtime.

Try this macro which uses FSO to read and write the files. A bit of array manipulation is used in the Get_Tabbed_Lines function, allowing population of the Quad arrays to use the same row and column numbers as your code.

Sub Split1536Loop2()

    Dim FileNameExt As Variant
    Dim FileNameNoExt As String
    Dim lines As Variant
    Dim Quad(1 To 4) As Variant
    Dim PlateData As Variant
    Dim i As Long
    Dim FSO As Object 'FileSystemObject
    Dim ts As Object 'TextStream
   
    FileNameExt = Application.GetOpenFilename(FileFilter:="Text Files (*.txt; *.csv), *.txt; *.csv", Title:="Please select a file")
    If FileNameExt = False Then
        MsgBox "Operation Cancelled", vbOKOnly
        Exit Sub
    End If
    
    FileNameNoExt = Left(FileNameExt, Len(FileNameExt) - 4)
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    'Set FSO = New Scripting.FileSystemObject
    
    Set ts = FSO.OpenTextFile(FileNameExt)
    lines = Split(ts.ReadAll, vbCrLf)
    
    Quad(1) = Get_Tabbed_Lines(lines, 1, 1, 16, 24)
    Quad(2) = Get_Tabbed_Lines(lines, 1, 25, 16, 48)
    Quad(3) = Get_Tabbed_Lines(lines, 17, 1, 32, 24)
    Quad(4) = Get_Tabbed_Lines(lines, 17, 25, 32, 48)
    PlateData = Get_Tabbed_Lines(lines, 34, 1, 36, 12)
    
    For i = 1 To 4
        Set ts = FSO.CreateTextFile(FileNameNoExt & "_Quad" & i & ".txt")
        ts.Write Join(Quad(i), vbCrLf)
        ts.WriteLine vbCrLf
        ts.Write Join(PlateData, vbCrLf)
        ts.Close
    Next
    
End Sub


'Returns a 1-dimensional array of lines with a tab separating each value for the specified start and end row and column
Private Function Get_Tabbed_Lines(lines As Variant, startRow As Long, startCol As Long, endRow As Long, endCol As Long) As Variant

    ReDim tabbedlines(1 To endRow - startRow + 1) As String
    Dim lineValues As Variant
    Dim r As Long, linesRow As Long
    Dim c As Long, col As Long
    
    r = 0
    For linesRow = startRow To endRow
        r = r + 1
        lineValues = Split(lines(linesRow - 1), vbTab)
        c = 0
        tabbedlines(r) = ""
        For col = startCol To endCol
            c = c + 1
            tabbedlines(r) = tabbedlines(r) & lineValues(col - 1) & vbTab
        Next
        tabbedlines(r) = Left(tabbedlines(r), Len(tabbedlines(r)) - 1) 'remove tab at end of line
    Next
    
    Get_Tabbed_Lines = tabbedlines
    
End Function