Exported TXT file is too big - mistake in code?

Question

I have a macro which exports XLS to TXT and it works fine, except that the resulting TXT contains not only the useful data, but also empty lines below this data.

I may be mistaken, but looks like empty Excel cells are exported too. Is there a way to improve my code to export only those cells which have data?

Here's the link to the XLS file to be exported.

Here's the link to the resulting TXT file. Use keyboard arrow keys to see empty TABs below line #1, which contains useful data.

And here's the code:

Option Explicit

Sub Export_to_TXT_UTF16()

Dim saveas_filename As Variant
saveas_filename = Application.GetSaveAsFilename(FileFilter:="Unicode Text (*.txt), *.txt", Title:="SaveAs")
If saveas_filename = False Then
    Exit Sub
End If

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

ActiveSheet.Copy

With ActiveSheet.UsedRange
    .Value = .Value
End With

Rows(1).Delete          'DELETE ROW #1

Columns("C:G").Delete       'DELETE COLUMNS C-G

ActiveWorkbook.SaveAs Filename:=saveas_filename, FileFormat:=xlUnicodeText

ActiveWorkbook.Close SaveChanges:=False

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

MsgBox "Your data has been exported!", vbExclamation, "Sheet Exported"

End Sub

Answer 1

You may have non-printable characters, like spaces, or more likely carriage returns. Can you run the code below? Then re-run your code above and get back to me with the results.

Sub CleanUpData()
    Dim Ws As Worksheet
    Dim Rng As Range, Cell As Range
    Dim ArrCodes
    Dim i As Long

    Set Ws = ActiveSheet
    On Error Resume Next
    Set Rng = Ws.UsedRange.SpecialCells(xlConstants, xlNumbers + xlTextValues)
    If Rng Is Nothing Then
        Exit Sub
    End If
    On Error GoTo 0

    ArrCodes = Array(127, 129, 141, 143, 144, 157, 160)

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    For Each Cell In Rng
        'Use the CLEAN function to remove 32 non printing chracters (0 to 31)
        'Trim is for removing leading and trailing blanks
        Cell = Trim(WorksheetFunction.Clean(Cell))
        'Now remove character code 127, 129, 141, 143, 144, 157, 160
        For i = LBound(ArrCodes) To UBound(ArrCodes)
            Cell = Replace(Cell, Chr(ArrCodes(i)), "")
        Next i
    Next Cell

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

As an alternative, this code will loop through all sheets and save each one as a separate text file. If you just want to save one single sheet as a text file, just don't run the loop, and active whatever single page you want to export as a flat file.

Sub SaveAllAsTextFile()

For Each xWs In Application.ActiveWorkbook.Worksheets
    xWs.Copy
    xTextFile = CurDir & "\temp_" & xWs.Name & ".txt"
    Application.ActiveWorkbook.SaveAs Filename:=xTextFile, FileFormat:=xlText
    Application.ActiveWorkbook.Saved = True
    Application.ActiveWorkbook.Close
Next

Dim shl As Object: Set shl = CreateObject("WScript.shell")
shl.CurrentDirectory = CurDir
shl.Run "cmd /C copy temp_*.txt " & ThisWorkbook.Name & ".txt" ' merge the temporary text files

'shl.Run "cmd /C del temp_*.txt" ' clean up the temporary text files


End Sub