Convert excel data to fixed width text file

[Klartigue]

I am tyring to convert data in an excel doc to a fixed width text file. In the excel doc, I have a "header" sheet, "detail" sheet, and trailer "sheet".

The results need to be the data in a fixed width text file. I have attached the excel doc and another doc with what the txt file should look like when I am done.

I have no experience using VBA to convert an excel doc to a text file so any help would be appreciated.

Thanks

[Blade Hunter]

Here is something similar I had to do.



Option Explicit
Dim MyString As String


Sub Convert_To_D1()
Dim vFileName As Variant, ArchiveFolder As String, Y As Long
ArchiveFolder = "G:\Operations\DansTools\Finance\Owner D1 output macro\"
Application.DisplayAlerts = False
vFileName = ArchiveFolder & "D1OutputFile" & ".txt"
Open vFileName For Output As #1
For Y = 2 To Range("A" & Rows.Count).End(xlUp).Row
BuildString (Y)
Print #1, MyString
Next
BuildTrailerRecord
Print #1, MyString
Close #1
'ActiveWindow.Close False
Application.DisplayAlerts = True
End Sub


Private Sub BuildTrailerRecord()
Dim RecordTypeIndicator As String, FieldLen As Variant, X As Long, MyValue As String, PadSide As Variant
RecordTypeIndicator = "2"
MyString = ""
FieldLen = Array(4, 10, 15, 15, 17, 196) 'Starts with second value, First is always RecordTypeIndicator
PadSide = Array(1, 1, 1, 1, 1, 0, 1) '1 = pad on right, 0 = pad on left
MyString = RecordTypeIndicator
For X = LBound(FieldLen) To UBound(FieldLen)
Select Case X 'Some values need to be a certain decimal place but still padded out with spaces. Ugly but it works.
Case 0
MyValue = "0222"
Case 1
MyValue = Range("A" & Rows.Count).End(xlUp).Row - 1
Case 2
MyValue = Format(Application.WorksheetFunction.Sum(Range("N2:N" & Range("A" & Rows.Count).End(xlUp).Row)), "0")
Case 3
MyValue = Format(Application.WorksheetFunction.Sum(Range("O2:O" & Range("A" & Rows.Count).End(xlUp).Row)), "0")
Case 4
MyValue = Format(Application.WorksheetFunction.Sum(Range("R2:R" & Range("A" & Rows.Count).End(xlUp).Row)), "0.00")
Case 5
MyValue = ""
End Select
If PadSide(X) = 1 Then
MyString = MyString & Left(MyValue & Application.WorksheetFunction.Rept(" ", FieldLen(X)), FieldLen(X))
Else
MyString = MyString & Right(Application.WorksheetFunction.Rept(" ", FieldLen(X)) & MyValue, FieldLen(X))
End If
Next
End Sub


Private Sub BuildString(RowNum)
Dim RecordTypeIndicator As String, FieldLen As Variant, X As Long, MyValue As String, PadSide As Variant
RecordTypeIndicator = "1"
MyString = ""
FieldLen = Array(4, 8, 14, 3, 1, 2, 3, 13, 7, 7, 13, 7, 13, 10, 10, 7, 7, 16, 7, 4, 15, 30, 30, 1, 1, 11, 4, 4, 16, 20, 30, 30, 20, 3, 4, 4, 3) 'Starts with second value, First is always RecordTypeIndicator
PadSide = Array(1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1) '1 = pad on right, 0 = pad on left
MyString = RecordTypeIndicator
For X = LBound(FieldLen) To UBound(FieldLen)
Select Case X 'Some values need to be a certain decimal place but still padded out with spaces. Ugly but it works.
Case 7
MyValue = Format(Cells(RowNum, X + 1).Value, "0.0000")
Case 8
MyValue = Format(Cells(RowNum, X + 1).Value, "0.000")
Case 9
MyValue = Format(Cells(RowNum, X + 1).Value, "0.000")
Case 10
MyValue = Format(Cells(RowNum, X + 1).Value, "0.0000")
Case 11
MyValue = Format(Cells(RowNum, X + 1).Value, "0.000")
Case 12
MyValue = Format(Cells(RowNum, X + 1).Value, "0.0000")
Case 13
MyValue = Format(Cells(RowNum, X + 1).Value, "0")
Case 14
MyValue = Format(Cells(RowNum, X + 1).Value, "0")
Case 15
MyValue = Format(Cells(RowNum, X + 1).Value, "0.000")
Case 16
MyValue = Format(Cells(RowNum, X + 1).Value, "0.000")
Case 17
MyValue = Format(Cells(RowNum, X + 1).Value, "0.0000")
Case 18
MyValue = Format(Cells(RowNum, X + 1).Value, "0.000")
Case 25
MyValue = Format(Cells(RowNum, X + 1).Value, "0.00000")
Case 28
MyValue = Format(Cells(RowNum, X + 1).Value, "0.0000")
Case Else
MyValue = Cells(RowNum, X + 1).Text
End Select
If PadSide(X) = 1 Then
MyString = MyString & Left(MyValue & Application.WorksheetFunction.Rept(" ", FieldLen(X)), FieldLen(X))
Else
MyString = MyString & Right(Application.WorksheetFunction.Rept(" ", FieldLen(X)) & MyValue, FieldLen(X))
End If
Next
End Sub


You will need to tailor to your needs but I think it's fairly simple code to modify. Post back if you get stuck.

[SamT]

Simple:

For Each Cel in UsedRange
fwText = Cel.Text
Do while Len(fwText) < 8 'Adjust as needed
fwText = " " & fwText
Loop
Cel.Text = fwText
Next Cel

Faster:

For Each Cel in UsedRange
Select Case Len(Cel.Text)
Case 0: Cel.Text = "' " 'Apostrophe and 8 spaces. Apostrophe will not be in Text file
Case 1: Cel.Text = "' " & Cel.text 'Apostrophe and 7 spaces. Apostrophe required to preserve format with numerals
Case 2: Cel.Text = "' " & Cel.Text 'Apostrophe and 6 spaces
Case Etc: Lather, Rinse and Repeat
End Select
Next Cel