2 Decimal Format in VBA Code

[oleflar]

Hi Everyone,

The following code converts my excel file to a fixed length text file, however I need some of the columns to format to 2 decimal places. Can someone let me know how to change the coding to accomplish this?

Thanks!

Option Explicit

Sub CreateFixedWidthFile(strFile As String, ws As Worksheet, s() As Integer)
Dim i As Long, j As Long
Dim strLine As String, strCell As String

'get a freefile
Dim fNum As Long
fNum = FreeFile

'open the textfile
Open strFile For Output As fNum
'loop from first to last row
'use 2 rather than 1 to ignore header row
For i = 1 To ws.Range("a65536").End(xlUp).Row
'new line
strLine = ""
'loop through each field
For j = 0 To UBound(s)
'make sure we only take chars up to length of field (may want to output some sort of error if it is longer than field)
strCell = Left$(ws.Cells(i, j + 1).Value, s(j))
'add on string of spaces with length equal to the difference in length between field length and value length
strLine = strLine & strCell & String$(s(j) - Len(strCell), Chr$(32))
Next j
'write the line to the file
Print #fNum, strLine
Next i
'close the file
Close #fNum

End Sub


'for example the code could be called using:

Sub CreateFile()
Dim sPath As String
sPath = Application.GetSaveAsFilename("", "Text Files,*.txt")
If LCase$(sPath) = "false" Then Exit Sub
'specify the widths of our fields
'the number of columns is the number specified in the line below +1
Dim s(43) As Integer
'starting at 0 specify the width of each column
s(0) = 9
s(1) = 25
s(2) = 14
s(3) = 1
s(4) = 64
s(5) = 8
s(6) = 30
s(7) = 30
s(8) = 20
s(9) = 2
s(10) = 10
s(11) = 2
s(12) = 20
s(13) = 6
s(14) = 12
s(15) = 8
s(16) = 8
s(17) = 30
s(18) = 1
s(19) = 8
s(20) = 8
s(21) = 8
s(22) = 1
s(23) = 30
s(24) = 20
s(25) = 30
s(26) = 8
s(27) = 8
s(28) = 12
s(29) = 3
s(30) = 8
s(31) = 13
s(32) = 1
s(33) = 12
s(34) = 1
s(35) = 2
s(36) = 8
s(37) = 8
s(38) = 13
s(39) = 4
s(40) = 13
s(41) = 13
s(42) = 6
s(43) = 200



'for example to use 3 columns with field of length 5, 10 and 15 you would use:
'dim s(2) as Integer
's(0)=5
's(1)=10
's(2)=15
'write to file the data from the activesheet
CreateFixedWidthFile sPath, ActiveSheet, s
End Sub

 

[Worf]

Hi and welcome to the Board

Try something like this:

Sub CreateFixedWidthFile(strFile As String, ws As Worksheet, s%())
Dim i As Long, j As Long, strLine As String, strCell As String, fnum&
fnum = FreeFile
Open strFile For Output As fnum
'loop from first to last row
'use 2 rather than 1 to ignore header row
For i = 1 To ws.Range("a65536").End(xlUp).Row
    'new line
    strLine = ""
    'loop through each field
    For j = 0 To UBound(s)
        'make sure we only take chars up to length of field
        strCell = [COLOR=#daa520]Format(Left$(ws.Cells(i, j + 1).Value, s(j)), "0.00")[/COLOR]
        'add on string of spaces with length equal to the difference between field length and value length
        strLine = strLine & strCell & String$(s(j) - Len(strCell), Chr$(32))
    Next j
    'write the line to the file
    Print #fnum, strLine
Next i
'close the file
Close #fnum
End Sub


Sub CreateFile()
Dim sPath$, s%(2)
sPath = Application.GetSaveAsFilename("", "Text Files,*.txt")
If LCase$(sPath) = "false" Then Exit Sub
'specify the widths of our fields
'the number of columns is the number specified in the line below +1
'starting at 0 specify the width of each column
s(0) = 9
s(1) = 25
s(2) = 15
CreateFixedWidthFile sPath, ActiveSheet, s
End Sub