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