Excelk VB code

[Stevevb]

Hi,

I have used the code that Mark007 very kindly published to create fixed width files.

I need two additions to this really helpful code:

1. If value in a row, column 7 is zero, the row/s need to be removed before the file is written

2. If the value in a row, columns 1, 2 and 5 are the same, then the values of column 7 need to be accumulated and a single line created rather.

If anyone is able to help I would be very grateful.

Thanks,

Stevevb

[Bob Phillips]

Where's the code Steve, as I suggested? Make it easy on us.

BTW, point 2. Could you re-phrase. I presume this could be over multiple lines but you don't explain how.


__________________________________________
UK Cambridge XL Users Conference 29-30 Nov
http://www.exceluserconference.com/UKEUC.html

[Stevevb]

I'm sorry - I didn't understand, code used is as below:

[VBA]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 = 3 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(11) As Integer
'starting at 0 specify the width of each column
s(0) = 12
s(1) = 6
s(2) = 6
s(3) = 6
s(4) = 12
s(5) = 30
s(6) = 19
s(7) = 3
s(8) = 1
s(9) = 64
s(10) = 3
'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[/VBA]

Point 2: There may be several lines in the file which need to be consolidated into one. If values in the rows, columns 1,2 and 5 and the same, I need to combine these into a single line but accumulating the values in column 7. Effectively, reducing the number of lines.

Thanks very much

[Bob Phillips]

This takes care of point 1, but I need clarification on point 2 as i explained.

[vba]

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 = 3 To ws.Range("A" & ws.Rows.Count).End(xlUp).Row
If ws.Cells(i, "G").Value <> 0 Then
'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
End If
Next i
'close the file
Close #fNum

End Sub
[/vba]


__________________________________________
UK Cambridge XL Users Conference 29-30 Nov
http://www.exceluserconference.com/UKEUC.html

[Stevevb]

Wow - thanks so much.

Point 2: Will the attachement help?

[Bob Phillips]

It might, if I could get past the password.

_________________________________________
UK Cambridge XL Users Conference 29-30 Nov
http://www.exceluserconference.com/UKEUC.html

[Stevevb]

Not very good at this am I? I thought the password had been removed.

The password is MINESMVB

Sorry!

[Bob Phillips]

This does change your master workbook, so you need to close it without saving afterwards

[vba]

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
With ws
For i = 3 To .Range("A" & ws.Rows.Count).End(xlUp).Row
If .Cells(i, "G").Value <> 0 Then
If .Cells(i, "A").Value = .Cells(i + 1, "A").Value And _
.Cells(i, "B").Value = .Cells(i + 1, "B").Value And _
.Cells(i, "E").Value = .Cells(i + 1, "E").Value Then
.Cells(i + 1, "G").Value = .Cells(i + 1, "G").Value + .Cells(i, "G").Value
Else
'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
End If
End If
Next i
End With
'close the file
Close #fNum

End Sub
[/vba]


_________________________________________
UK Cambridge XL Users Conference 29-30 Nov
http://www.exceluserconference.com/UKEUC.html

[Stevevb]

Fantastic! Thanks very much, I really appreciate your help.