Export an excel file to txt with same formatting - excel

Question

I have an excel file written in this way:
187712 201 37 0.18
2525 580 149 0.25
136829 137 43 0.31
I need to export this file with same spaces, same formatting in a txt file. How can i do it? I've tryied Save As | Formatted Text (Space Delimited) (*.prn) but not working because i have an issue on the last column. Is there a macro? Thanks.
EDIT: i tryied a macro:
Sub TEST()
Dim c As Range, r As Range
Dim output As String
For Each r In Range("A1:L504").Rows
For Each c In r.Cells
output = output & " " & c.Value
Next c
output = output & vbNewLine
Next r
Open "D:\MyPath\text.txt" For Output As #1
Print #1, output
Close
End Sub
but the result is
187712 201 37 0.18
2525 580 149 0.25
136829 137 43 0.31
These values are only an example because there are about 504 columns!! Anyway the problem is that if in the first column there is a value shorter then the others it lost the formatting like the second row as you can see.

Answer 1

Your posted data shows fixed fields with field-widths of 8,7,7,4 (each field is a combination of characters and trailing blanks). These can be adjusted as necessary in the macro below. Also adjust the folder name to suit your needs:
Sub FixedField()
Dim fld(1 To 4) As Long
Dim V(1 To 4) As String
Dim N As Long, L As Long
Dim K As Long
fld(1) = 8
fld(2) = 7
fld(3) = 7
fld(4) = 4
N = Cells(Rows.Count, "A").End(xlUp).Row
Close #1
Open "c:\TestFolder\test.txt" For Output As #1
For L = 1 To N
outpt = ""
For K = 1 To 4
V(K) = Cells(L, K).Text
While Len(V(K)) <> fld(K)
V(K) = V(K) & " "
Wend
outpt = outpt & V(K)
Next K
MsgBox outpt
Print #1, outpt
Next L
Close #1
End Sub
It is also assumed that the data starts in column A.

Answer 2

I struggled with that also numerous times, the only way I found was with a VBA function I created (the tricky part is determining the "widest" column for plain-text layout). Fair warning: I didn't build a lot "smarts" into this, the output can be a little quirky.
Usage:
Select the cells you want formatted to plain-text, then run the macro (I have the macro assigned to a button, I use it all the time!). If the top row is center-aligned, then let's /assume/ it's a header. And watch for right-aligned columns, and output those right-aligned.
The marco will copy the desired output to the clip-board, then paste the result in Notepad (or similar) to do with as desired.
Example output (I threw in some headers)
CustId Views Selected Cost
187712 201 37 0.18
2525 580 149 0.25
136829 137 43 0.31
The code:
Sub FormatSelectionToPlainText()
' ---------------------------------------------------------------------------
' Author: Jay R. Ohman
' Ohman Automation Corp., http://www.OhmanCorp.com
' ** disclaimer and release: I am NOT an expert **
' ** programmer, use my coding at your own risk! **
' ---------------------------------------------------------------------------
Dim rFound As Range, RngCol1 As Integer, RngRow1 As Integer, ActCol As Integer, ActRow As Integer, x As Integer
Dim MaxCellLen() As Variant, CellAlignRight() As Variant, HdrLen() As Variant, xDbg As Boolean, xVal As Variant
Dim SepSpace As Integer, RetStr As String, RetLen As Integer, MsgStr As String, HasHdr As Boolean
Dim GeneralIsRightAlignedFactor As Single, TotalRows As Integer
Dim oClip As DataObject
xDbg = True ' output stuff to the immediate window?
GeneralIsRightAlignedFactor = 0.75 ' threshhold for deeming a column as right-aligned
Set oClip = New DataObject
MsgStr = "(looking for top row to be center aligned as header)"
If MsgBox("Are the cells to be copied selected?" & vbCrLf & MsgStr, vbYesNo + vbQuestion, "Auto-Fill Time Slots") = vbYes Then
If (Selection Is Nothing) Then
MsgBox "Nothing Selected."
Else
SepSpace = 2 ' number of spaces between columns
RetLen = 0
HasHdr = True
Set rFound = Selection
RngCol1 = rFound.Column
RngRow1 = rFound.Row
Debug.Print Selection.Columns.Count
ReDim Preserve MaxCellLen(Selection.Columns.Count) ' max cell length
ReDim Preserve CellAlignRight(Selection.Columns.Count) ' track the cell alignment
ReDim Preserve HdrLen(Selection.Columns.Count) ' header row max cell length
For ActCol = RngCol1 To RngCol1 + Selection.Columns.Count - 1
x = (ActCol - RngCol1 + 1)
' If xDbg Then Debug.Print Cells(RngRow1, ActCol).HorizontalAlignment
If (Cells(RngRow1, ActCol).HorizontalAlignment <> xlCenter) And (Cells(RngRow1, ActCol).Value <> "") Then HasHdr = False
HdrLen(x) = IIf(HasHdr, Len(Cells(RngRow1, ActCol).Value), 0)
MaxCellLen(x) = 0
CellAlignRight(x) = 0
Next
If xDbg Then Debug.Print "HasHdr: " & HasHdr
TotalRows = (RngRow1 + Selection.Rows.Count) - (RngRow1 + IIf(HasHdr, 1, 0))
For ActCol = RngCol1 To RngCol1 + Selection.Columns.Count - 1 ' go find the longest text in each column
x = (ActCol - RngCol1 + 1)
xVal = IIf(HasHdr, 1, 0)
For ActRow = RngRow1 + xVal To RngRow1 + Selection.Rows.Count - 1
' If xDbg Then Debug.Print Cells(ActRow, ActCol).HorizontalAlignment
xVal = Cells(ActRow, ActCol).Value
If (MaxCellLen(x) < Len(Cells(ActRow, ActCol).Value)) Then MaxCellLen(x) = Len(xVal)
If (Cells(ActRow, ActCol).HorizontalAlignment = xlRight) Or _
((Cells(ActRow, ActCol).HorizontalAlignment = xlGeneral) And (IsDate(xVal) Or IsNumeric(xVal))) Then _
CellAlignRight(x) = CellAlignRight(x) + 1
Next
If xDbg Then Debug.Print "Max Length for Column " & ActCol & ": " & MaxCellLen(x) & _
", CellAlignRight.Count: " & CellAlignRight(x) & "/" & TotalRows
RetLen = RetLen + MaxCellLen(x) + SepSpace
Next
RetLen = RetLen - SepSpace ' subtract that last separator space
If HasHdr Then
For ActCol = RngCol1 To RngCol1 + Selection.Columns.Count - 1
x = (ActCol - RngCol1 + 1)
If (HdrLen(x) > MaxCellLen(x)) Then MaxCellLen(x) = HdrLen(x)
Next
End If
RetStr = "" ' build the output text
For ActRow = RngRow1 To RngRow1 + Selection.Rows.Count - 1
For ActCol = RngCol1 To RngCol1 + Selection.Columns.Count - 1
x = (ActCol - RngCol1 + 1)
MsgStr = Cells(ActRow, ActCol).Value ' re-use string variable
' format for right-aligned
If (CellAlignRight(x) / TotalRows >= GeneralIsRightAlignedFactor) And (Not (HasHdr And (ActRow = 1))) Or (Cells(ActRow, ActCol).HorizontalAlignment = xlRight) Then ' aligned right
RetStr = RetStr & Space(MaxCellLen(x) - Len(MsgStr)) & MsgStr
ElseIf (Cells(ActRow, ActCol).HorizontalAlignment = xlCenter) Then
xVal = Fix((MaxCellLen(x) - Len(MsgStr)) / 2)
RetStr = RetStr & Space(xVal) & MsgStr & Space(MaxCellLen(x) - Len(MsgStr) - xVal)
Else
RetStr = RetStr & MsgStr & Space(MaxCellLen(x) - Len(MsgStr))
End If
If ((ActCol - RngCol1) + 1 < UBound(MaxCellLen)) Then RetStr = RetStr & Space(SepSpace)
Next
RetStr = RetStr & vbCrLf
Next
oClip.SetText RetStr
oClip.PutInClipboard
MsgBox ("The selection has been copied to clipboard." & vbCrLf & "Max line length: " & RetLen)
End If
Else
MsgBox ("Have a nice day. :)")
End If
End Sub