Remove empty rows from .txt file

M

margentieri

Board Regular
Joined
Apr 13, 2016
Messages
50
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!

Code: 
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!
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Sort by date Sort by votes
A different approach is needed - use FileSystemObject to create the text files from the arrays.

Code: 
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.
 
Upvote 0
John_w said:
A different approach is needed - use FileSystemObject to create the text files from the arrays.

Code: 
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.
Click to expand...


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!
 
Last edited:
Upvote 0
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.

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
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Solved
More Efficient Looping
2
Replies
19
Views
243
bhsoundman
B
A
  • Question Question
Looking for help in Excel Macros scripts
Replies
0
Views
89
Adnan199
A
D
  • Solved
Error 1004
2
Replies
18
Views
401
dmt32
D
T
  • Solved
Import Data Starting from next empty row
Replies
7
Views
477
Tanne
T
WERNER SLABBERT
  • Question Question
Run-time error 70 after code changed
Replies
3
Views
113
RoryA
RoryA

Forum statistics

Threads
1,224,737
Messages
6,180,662
Members
452,992
Latest member
TokugawaIesuma

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top