Solved: Loops that write specific data to file

[MeiR_ct]

Hi all.
I'm trying to create detailed report pages based on excel data.

Here's a little view to the sheet:
ht tp://i33.tinypic.com/2q8dpoi.jpg
I've also attaced this sample if you want to work on it.

First of all, I want the method to "remember" some coulmns by their titles (they'll be always the same), and "know" where to find the needed data.
I guess it'll be several loops that search for "title" and strore the column indexes in variables. ("Business Name" into BusNameCol, "Sign Content" into SignContentCol, etc.)

Now, I want a loop that runs on "Property ID" column (its index will be stored in PropIDCol).
When the loop finds a "new" (not yet handled) value, it will:

• * Create a new file, named as the property id value.
• * Print to file, *only once*, some values like businnes name, owner name, etc. (their column indexes are stored)
• * Print in a new line some other values, like sign content, width, height, etc. (their column indexes are stored)
• * Loop on the rest of lines of the current handled "Property ID", and continue creating new lines for those same other values.

NOTICE: Same property ids are not all in sequence! So it's not a simple "while" loop. It'll need to "collect" from the close range (let's say 50 lines).

• * After that, it'll return to the "main" loop and move to the next "new" property id.

For the method to know where to "return" to, my idea is to have a "check" column (its index in CheckCol). For every line the method handles, it'll put "1" in this column.
It also will be good if I want to run the macro several times (if businesses are added in future), and not to have multiple report files.


There is also line 12 in the picture, which doesn't have property and owner data, I think that in this case it will collect according to business name instead of property id.


-------------------------------------------------------
OUTPUT EXAMPLE:

BusinessName: Paz | Owner ID: 510216054 | Property ID: 166143000003 | Owner Name: Paz Company Ltd. | Owner Address: P.O.B. 222 City

(Sign Content | Width (cm) | Height (cm) | Rounded Area | Sign Address - Street | Sign Address - House | Sign Location)

Tasty Yellow | 250 | 230 | 6 | rd. 434 | 21 | Display Window
Paz (changing ads) | 90 | 60 | 1 | rd. 434 | 21 | Bulding Wall
Paz (changing ads) | 90 | 60 | 1 | rd. 434 | 21 | Bulding Wall
Price List | 120 | 60 | 1 | rd. 434 | 21 | Pole
Paz | 80 | 60 | 1 | rd. 434 | 23 | Gas Station

-------------------------------------------------------

Thanks *A LOT* in advance for all the helpers!!!

=-= MeiR =-=

[MeiR_ct]

Mmm.. Should I assume that no one here has experience with VBA loops? :\

Please people, I need your help, it's quite urgent for me...
Thanks.

[MeiR_ct]

bump.

[Kenneth Hobs]

Your project is fairly involved. There are some items that are a bit unclear. There are several assumptions that will be required that may not be in the direction that you wanted. This is why no one has replied yet.

Doing loops is easy. The method to accomplish all of your goals is more involved. If I get time late this weekend, I will give you something to examine if no one has solved your problem by then.

[MeiR_ct]

I can try and write some code (from the little clue I have about vba), hoping that someone will fix it into correct syntax...
[vba]
for x = 1 to LAST_CELL ' I assume there`s some way to run until last used bottom cell

if cell(x, CheckCol).value = "1" then goto Next ' This line was handled already


CurrentProp = cell(x, PropertyCol).value
CREATE_FILE CurrentProp + ".txt" ' Replace with the correct command

print CurrentProp + ".txt", "Business Name:" cell(i, BusNameCol).value "| Owner ID:" cell(i, OwnerIDCol).value _
"| Owner name:" cell(i, OwnerNameCol).value "| Owner Address:" cell(i, OwnerAddressCol).value
print CurrentProp + ".txt", vbCrlf
print CurrentProp + ".txt", " "
print CurrentProp + ".txt", "(Sign Content | Width (cm) | Height (cm) | Rounded Area | Sign Address - Street | Sign Address - House | Sign Location)"

cell(x, CheckCol).value = "1" ' Put "1" near every handled line, in "check" column. Or maybe should it be: cells(x, CheckCol) = 1 ?

i = x + 1
NextRange = i + 200
while i < NextRange do ' I'm still not sure if to scan and "collect" from close range or the whole sheet

if cell(i, PropertyCol).value = CurrentProp then

print CurrentProp + ".txt", cell(i, SignContentCol).value "|" cell(i, WidthCol).value "|" cell(i, HeightCol).value _
"|" cell(i, AreaCol).value "|" cell(i, SignStreetCol).value "|" cell(i, SignHouseCol).value "|" cell(i, SignLocationCol).value

NextRange = i + 200 ' As long as u find another match, run on next 200 lines
cell(i, CheckCol).value = 1 ' Put "1" near every handled line, in "check" column

end if

i = i + 1
loop

Next: ' For the goto above
next x
[/vba]

[GTO]

Mmm.. Should I assume that no one here has experience with VBA loops? :\

Please people, I need your help, it's quite urgent for me...
Thanks.

I tried ignoring the "humor" and the fact that you are asking for some considerable coding as Kenneth mentioned.

If one could likewise disregard the 'quite urgent' rush to provide their off-time, then maybe I'd be surprised folks aren't tossing the kids outside so they can concentrate on this.

Maybe its because you've had it cross-posted for four days and haven't bothered to mention...

Cross-posted at: http://www.mrexcel.com/forum/showthread.php?t=493192

Please read Here.

[Kenneth Hobs]

Before I put effort into this tomorrow, if you can post an xls or doc or txt file of what you expect for output, that would help us help you more specifically. I know that you have put some effort into posting what you need but more feedback is needed to get a specific output.

Unless your code is close to what you need and works somewhat, it is best not to post any. It appears that you are trying to write to a text file. Your MrExcel example output had some bold format codes which can not be placed in a text file.

Also, try not to suggest a method for help. A specific solution route might solve your problem but it may not be the most efficient nor the fastest.

[mohanvijay]

try this code

i attached excel file

[vba]
trows = Range("a65536").End(xlUp).Row
Dim yes As Boolean
Dim pid As Integer
Dim tprid(), cprid(1 To 10000), twb() As Variant
ReDim tprid(1 To trows) As Variant
yes = False
pid = 1

For i = 2 To trows
If Cells(i, 16).Value <> "" Then
tprid(pid) = Cells(i, 16).Value
Else
tprid(pid) = Cells(i, 6).Value
End If
pid = pid + 1
Next i

pid = 1

For td = 1 To trows
tda = tprid(td)
For cd = 1 To pid
ttda = cprid(cd)
If tda = ttda Then yes = True
Next cd
If yes = False Then
cprid(pid) = tda
pid = pid + 1
End If
yes = False
Next td

ReDim twb(1 To pid - 1) As Variant

Dim fodr As FileDialog
Dim npas As Integer
Dim yespr As Boolean

yespr = False

npas = 3

Set fodr = Application.FileDialog(msoFileDialogFolderPicker)

fodr.Title = "BROWSE FOLDER FOR SAVE EXCEL FILES"

If fodr.Show = -1 Then get_path = fodr.SelectedItems(1)

For final = 1 To pid - 1

wbname = cprid(final) & ".xls"
Set twb(final) = Workbooks.Add
twb(final).Title = wbname
twb(final).SaveAs Filename:=get_path & "\" & wbname & ".xls"

For filpr = 2 To trows
If cprid(final) = Workbooks("sample (1)").Sheets(1).Cells(filpr, 16).Value Then
Workbooks(wbname).Sheets(1).Cells(1, 1).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 6).Value
Workbooks(wbname).Sheets(1).Cells(1, 2).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 15).Value
Workbooks(wbname).Sheets(1).Cells(1, 3).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 16).Value
Workbooks(wbname).Sheets(1).Cells(1, 4).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 17).Value
Workbooks(wbname).Sheets(1).Cells(1, 5).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 18).Value

Workbooks(wbname).Sheets(1).Cells(npas, 1).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 7).Value
Workbooks(wbname).Sheets(1).Cells(npas, 2).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 8).Value
Workbooks(wbname).Sheets(1).Cells(npas, 3).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 9).Value
Workbooks(wbname).Sheets(1).Cells(npas, 4).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 10).Value
Workbooks(wbname).Sheets(1).Cells(npas, 5).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 12).Value
Workbooks(wbname).Sheets(1).Cells(npas, 6).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 13).Value
Workbooks(wbname).Sheets(1).Cells(npas, 7).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr, 14).Value
npas = npas + 1
yespr = True
End If
Next filpr

If yespr = False Then
For filpr2 = 2 To trows
If cprid(final) = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 6).Value Then
Workbooks(wbname).Sheets(1).Cells(1, 1).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 6).Value
Workbooks(wbname).Sheets(1).Cells(1, 2).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 15).Value
Workbooks(wbname).Sheets(1).Cells(1, 3).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 16).Value
Workbooks(wbname).Sheets(1).Cells(1, 4).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 17).Value
Workbooks(wbname).Sheets(1).Cells(1, 5).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 18).Value

Workbooks(wbname).Sheets(1).Cells(npas, 1).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 7).Value
Workbooks(wbname).Sheets(1).Cells(npas, 2).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 8).Value
Workbooks(wbname).Sheets(1).Cells(npas, 3).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 9).Value
Workbooks(wbname).Sheets(1).Cells(npas, 4).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 10).Value
Workbooks(wbname).Sheets(1).Cells(npas, 5).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 12).Value
Workbooks(wbname).Sheets(1).Cells(npas, 6).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 13).Value
Workbooks(wbname).Sheets(1).Cells(npas, 7).Value = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 14).Value
npas = npas + 1
End If
Next filpr2
End If

Workbooks(wbname).Save
Workbooks(wbname).Close
yespr = False
npas = 3

Next final

[/vba]

[mohanvijay]

I thought to create EXCEL files

here is the code for crated TXT files

i attached sample file

[vba]

trows = Range("a65536").End(xlUp).Row
Dim yes As Boolean
Dim pid As Integer
Dim tprid(), cprid(1 To 10000), twb() As Variant
ReDim tprid(1 To trows) As Variant
yes = False
pid = 1

For i = 2 To trows
If Cells(i, 16).Value <> "" Then
tprid(pid) = Cells(i, 16).Value
Else
tprid(pid) = Cells(i, 6).Value
End If
pid = pid + 1
Next i

pid = 1

For td = 1 To trows
tda = tprid(td)
For cd = 1 To pid
ttda = cprid(cd)
If tda = ttda Then yes = True
Next cd
If yes = False Then
cprid(pid) = tda
pid = pid + 1
End If
yes = False
Next td

ReDim twb(1 To pid - 1) As Variant

Dim fodr As FileDialog
Dim yespr, yestx As Boolean

yespr = False
yestx = False


Set fodr = Application.FileDialog(msoFileDialogFolderPicker)

fodr.Title = "BROWSE FOLDER FOR SAVE TEXT FILES"

If fodr.Show = -1 Then get_path = fodr.SelectedItems(1)

txtfile = FreeFile

For final = 1 To pid - 1

txtname = cprid(final) & ".txt"

Open txtname For Output As #txtfile

For filpr = 2 To trows
If cprid(final) = Workbooks("sample (1)").Sheets(1).Cells(filpr, 16).Value Then
prtxt = ""
If yestx = False Then
prtxt = prtxt & "Business Name: " & Workbooks("sample (1)").Sheets(1).Cells(filpr, 6).Value & " | "
prtxt = prtxt & "Owner ID: " & Workbooks("sample (1)").Sheets(1).Cells(filpr, 15).Value & " | "
prtxt = prtxt & "Property ID: " & Workbooks("sample (1)").Sheets(1).Cells(filpr, 16).Value & " | "
prtxt = prtxt & "Owner Name: " & Workbooks("sample (1)").Sheets(1).Cells(filpr, 17).Value & " | "
prtxt = prtxt & "owner Address: " & Workbooks("sample (1)").Sheets(1).Cells(filpr, 18).Value
Print #txtfile, prtxt
yestx = True
End If

prtxt = ""

prtxt = prtxt & Workbooks("sample (1)").Sheets(1).Cells(filpr, 7).Value & " | "
prtxt = prtxt & Workbooks("sample (1)").Sheets(1).Cells(filpr, 8).Value & " | "
prtxt = prtxt & Workbooks("sample (1)").Sheets(1).Cells(filpr, 9).Value & " | "
prtxt = prtxt & Workbooks("sample (1)").Sheets(1).Cells(filpr, 10).Value & " | "
prtxt = prtxt & Workbooks("sample (1)").Sheets(1).Cells(filpr, 12).Value & " | "
prtxt = prtxt & Workbooks("sample (1)").Sheets(1).Cells(filpr, 13).Value & " | "
prtxt = prtxt & Workbooks("sample (1)").Sheets(1).Cells(filpr, 14).Value

Print #txtfile, prtxt

yespr = True
End If
Next filpr

If yespr = False Then
For filpr2 = 2 To trows
If cprid(final) = Workbooks("sample (1)").Sheets(1).Cells(filpr2, 6).Value Then
prtxt = ""
If yestx = False Then
prtxt = prtxt & "Business Name:" & Workbooks("sample (1)").Sheets(1).Cells(filpr2, 6).Value & " | "
prtxt = prtxt & "Owner ID: " & Workbooks("sample (1)").Sheets(1).Cells(filpr2, 15).Value & " | "
prtxt = prtxt & "Property ID: " & Workbooks("sample (1)").Sheets(1).Cells(filpr2, 16).Value & " | "
prtxt = prtxt & "Owner Name: " & Workbooks("sample (1)").Sheets(1).Cells(filpr2, 17).Value & " | "
prtxt = prtxt & "Owner Address: " & Workbooks("sample (1)").Sheets(1).Cells(filpr2, 18).Value
Print #txtfile, prtxt
yestx = True
End If

prtxt = ""

prtxt = prtxt & Workbooks("sample (1)").Sheets(1).Cells(filpr2, 7).Value & " | "
prtxt = prtxt & Workbooks("sample (1)").Sheets(1).Cells(filpr2, 8).Value & " | "
prtxt = prtxt & Workbooks("sample (1)").Sheets(1).Cells(filpr2, 9).Value & " | "
prtxt = prtxt & Workbooks("sample (1)").Sheets(1).Cells(filpr2, 10).Value & " | "
prtxt = prtxt & Workbooks("sample (1)").Sheets(1).Cells(filpr2, 12).Value & " | "
prtxt = prtxt & Workbooks("sample (1)").Sheets(1).Cells(filpr2, 13).Value & " | "
prtxt = prtxt & Workbooks("sample (1)").Sheets(1).Cells(filpr2, 14).Value

Print #txtfile, prtxt

End If
Next filpr2
End If

Close #txtfile

yespr = False
yestx = False


Next final

[/vba]

[MeiR_ct]

I tried ignoring the "humor" and the fact that you are asking for some considerable coding as Kenneth mentioned.

If one could likewise disregard the 'quite urgent' rush to provide their off-time, then maybe I'd be surprised folks aren't tossing the kids outside so they can concentrate on this.

Maybe its because you've had it cross-posted for four days and haven't bothered to mention...

Cross-posted at: http://www.mrexcel.com/forum/showthread.php?t=493192

Please read Here.

First of all, I want to apologize for my cross-posting. As you can realize, I'm new to all of these help forums, and apparently haven't read well the rules as needed.
I just saw so many people getting support while I was waiting, and that troubled me, I assume. So, again: Sorry! :]


----------

Now, mohanvijay, thanks a lot for your time and help!
Hmm, your code runs into runtime error at line 59:

Run-time error '9':
Subscript out of range

That's the line:
[vba]
If cprid(final) = Workbooks("sample (1)").Sheets(1).Cells(filpr, 16).Value Then[/vba]
I have some programming knowledge, and I tried to provide a code idea above.
Since the method is supposed to write thousands of files at once, I decreased the use in loops as far as I could.

Can you or anyone else please have a look on my code?
I have no doubt it has mistakes, but I think its logic is the most efficient.

Thanks !!!

[MeiR_ct]

Kenneth Hobs, actually, the output example that I've provided in the first post above is exactly what I want.
The filename for this particular output will be 166143000003.txt (the unique property id of "Paz" which its data is collected)

-------------------------------------------------------
OUTPUT EXAMPLE:

Business Name: Paz | Owner ID: 510216054 | Property ID: 166143000003 | Owner Name: Paz Company Ltd. | Owner Address: P.O.B. 222 City

(Sign Content | Width (cm) | Height (cm) | Rounded Area | Sign Address - Street | Sign Address - House | Sign Location)

Tasty Yellow | 250 | 230 | 6 | rd. 434 | 21 | Display Window
Paz (changing ads) | 90 | 60 | 1 | rd. 434 | 21 | Bulding Wall
Paz (changing ads) | 90 | 60 | 1 | rd. 434 | 21 | Bulding Wall
Price List | 120 | 60 | 1 | rd. 434 | 21 | Pole
Paz | 80 | 60 | 1 | rd. 434 | 23 | Gas Station

-------------------------------------------------------

I've also attached a "Sample.xls" in the first post here. That's the file from the screenshot.

The method should create a separate txt file for every property id, printing the owner and business info (which are the same in all of the property lines) at the top of file, then a simple text line of titles related to signs, and under that the collected-by-loop sign data.

Now, about the text styles, you can ignore them. Currently, I need plain text.
In fact, I want to create html files finally, but as soon as I understand how the printing and looping work, I'll just edit the plain text and put html tags in it.

Finally, about the code\method I suggested:
If you wish, you can treat it as a textual algorithm which I want to implement in vba, and need your help with that. I've worked on it quite a while, in order to help the rest to help me.
I think that *it is* close enough to what I need, and *does* work somewhat, from the little clue I (and Google) have about vba, as I said.

Thanks

[Kenneth Hobs]

You may want to change the path for the folder variable or the right padded string lengths to suit. I dimmed a few more variables than needed. You can delete those as you like.

[vba]Sub MakeTheTXTFiles()
Dim folder As String
Dim r As Range, cell As Range, aRange As Range, pRange As Range
Dim arrayCN(1 To 12) As String, arrayCNcol(1 To 12), i As Integer
Dim s As String, sData As String
Dim lRow As Long, cRow As Long
Dim cVal, tfArchive As Boolean

folder = ThisWorkbook.Path & "\"

'Set column names in arrayCN()
arrayCN(1) = "Business Name"
arrayCN(2) = "Owner ID"
arrayCN(3) = "Property ID"
arrayCN(4) = "Owner Name"
arrayCN(5) = "Owner Address"
arrayCN(6) = "Sign Content"
arrayCN(7) = "Width (cm)"
arrayCN(8) = "Height (cm)"
arrayCN(9) = "Rounded Area"
arrayCN(10) = "Sign Address - Street"
arrayCN(11) = "Sign Address - House"
arrayCN(12) = "Sign Location"

'Set all elements of column name's column number array to 0.
For i = 1 To UBound(arrayCNcol)
arrayCNcol(i) = 0
Next i

'Fill column numbers for column names.
On Error Resume Next
For i = 1 To UBound(arrayCNcol)
arrayCNcol(i) = Rows(1).Find(what:=arrayCN(i)).Column
Next i
On Error GoTo 0

'Exit if any array column number is 0. It was not found.
For i = 1 To UBound(arrayCNcol)
If arrayCNcol(i) = 0 Then
MsgBox "Column name: " & arrayCN(i) & ", was not found.", vbCritical, "Macro Ending"
Exit Sub
End If
Next i

'Set Archive column if needed.
Set aRange = Rows(1).Find(what:="Archived")
If aRange Is Nothing Then
Set aRange = Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
With aRange
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Value = "Archived"
End With
Else: Set aRange = Rows(1).Find(what:="Archived")
End If

'Find the range of rows to process
Set pRange = Range(Cells(2, arrayCNcol(3)), Cells(Rows.Count, arrayCNcol(3)).End(xlUp)) 'p26
lRow = pRange.Rows.Count + 1

'Interate through rows and make new text files or append to existing files if archive not set.
For cRow = 2 To lRow
'Get Property ID value.
Set r = Cells(cRow, arrayCNcol(3))
'Skip if no Property ID.
If r.Value = "" Then GoTo NextcRow
'Skip if Archived=True.
If Cells(cRow, aRange.Column).Value = True Then GoTo NextcRow
'Text Filename
s = folder & r.Value & ".txt"
'Make text file if it does not exist.
If Dir(s) = "" Then
sData = arrayCN(1) & ": " & Cells(cRow, arrayCNcol(1)).Value & " | " 'Business Name
sData = sData & arrayCN(2) & ": " & Cells(cRow, arrayCNcol(2)).Value & " | " 'Owner ID
sData = sData & arrayCN(3) & ": " & Cells(cRow, arrayCNcol(3)).Value & " | " 'Property ID
sData = sData & arrayCN(4) & ": " & Cells(cRow, arrayCNcol(4)).Value & " | " 'Owner Name
sData = sData & arrayCN(5) & ": " & Cells(cRow, arrayCNcol(5)).Value 'Owner Address
sData = sData & vbCrLf & vbCrLf 'Add blank line
'Column names for adding Sign Content data and first record.
'Sign Content, Width (cm), Height (cm), Rounded Area, Sign Address - Street, _
Sign Address - House, Sign Location
'Pad Lengths = 25, 15, 15, 15, 50, 50, 30
sData = sData & Rpad(arrayCN(6), 25) & Rpad(arrayCN(7), 15) & _
Rpad(arrayCN(8), 15) & Rpad(arrayCN(9), 15) & Rpad(arrayCN(10), 50) & _
Rpad(arrayCN(11), 50) & Rpad(arrayCN(12), 30) & vbCrLf
sData = sData & Rpad(Cells(cRow, arrayCNcol(6)), 25)
sData = sData & Rpad(Cells(cRow, arrayCNcol(7)), 15)
sData = sData & Rpad(Cells(cRow, arrayCNcol(8)), 15)
sData = sData & Rpad(Cells(cRow, arrayCNcol(9)), 15)
sData = sData & Rpad(Cells(cRow, arrayCNcol(10)), 50)
sData = sData & Rpad(Cells(cRow, arrayCNcol(11)), 50)
sData = sData & Rpad(Cells(cRow, arrayCNcol(12)), 30)
MakeTXTFile s, sData
'Add Archived value.
Cells(cRow, aRange.Column).Value = True
End If
'Append record to text file if needed.
If Dir(s) <> "" And Cells(cRow, aRange.Column).Value <> True Then
sData = Rpad(Cells(cRow, arrayCNcol(6)), 25)
sData = sData & Rpad(Cells(cRow, arrayCNcol(7)), 15)
sData = sData & Rpad(Cells(cRow, arrayCNcol(8)), 15)
sData = sData & Rpad(Cells(cRow, arrayCNcol(9)), 15)
sData = sData & Rpad(Cells(cRow, arrayCNcol(10)), 50)
sData = sData & Rpad(Cells(cRow, arrayCNcol(11)), 50)
sData = sData & Rpad(Cells(cRow, arrayCNcol(12)), 30)
'Append now.
AppendToTXTFile s, sData
'Add Archived value.
Cells(cRow, aRange.Column).Value = True
End If
NextcRow:
Next cRow
End Sub

Function MakeTXTFile(strFile As String, strData As String) As Boolean
Dim iHandle As Integer, l As Long
iHandle = FreeFile
Open strFile For Output Access Write As #iHandle
Print #iHandle, strData
Close #iHandle
MakeTXTFile = True
End Function


Function AppendToTXTFile(strFile As String, strData As String) As Boolean
Dim iHandle As Integer, l As Long
iHandle = FreeFile
Open strFile For Append Access Write As #iHandle
Print #iHandle, strData
Close #iHandle
AppendToTXTFile = True
End Function

'http://support.microsoft.com/kb/96458
'=====================================================================
'The following function will right pad a string with a specified
'character. It accepts a base string which is to be right padded with
'characters, a character to be used as the pad character, and a
'length which specifies the total length of the padded result.
'=====================================================================
Function Rpad(MyValue$, MyPaddedLength%, Optional MyPadCharacter$ = " ")
Dim x As Integer
Dim PadLength As Integer

PadLength = MyPaddedLength - Len(MyValue)
Dim PadString As String
For x = 1 To PadLength
PadString = MyPadCharacter & PadString
Next
Rpad = MyValue + PadString

End Function
[/vba]

[mohanvijay]

Hmm, your code runs into runtime error at line 59:

Quote:
Run-time error '9':
Subscript out of range

this is because i forget to change the workbook name change the workbook name as "sample (1)" it will run

and i tested both codes, they run correctly

[MeiR_ct]

Thanks for your replies and sorry for my late reply, I had time just now to enter the thread.

Kenneth, thank a lot for the time you've invested, I really appreciate it!

I'll have more time at evening to test the code and read it deeper, but from what I see now there's an issue with the "appending" idea, and now I realize why you asked for small details.
It will indeed be very good and eficient, but I didn't mention that most of chances are that there might be more text after the sign data. I'll provide more details later.

Thanks again and have a nice day!

[Kenneth Hobs]

My solution loops as you requested. With what I have done, you can modify it to suit.

Obviously no solution is possible if the logic is not consistent and known. It is why I question twice and give a solution once...

[MeiR_ct]

Okay I have some free time finally. :]
Kenneth, I know i'm guilty of that, and I really understand you made your part. Thanks again for all of your important and generous help. I refer my request to others this time.

So, as I said, I plan to add more text to the files after writing the sign data.
I didn't want to bother so much, so I've just asked to get the general code that write into files with loops.
With the way which I thought it's gonna be, I would just add more "print" commands after the method "collected" the matching signs, and finished handling every particular file.
I want to keep the way of "appending", it's way more efficient, but the only solution I can think of, with this way, is to run another loop, after all the signs data is created. Otherwise we can't determine when the current handled line is the last entry of the matching property.

Or maybe I have another idea. (And tell me if I should, and allowed, to start a new thread about it)
Instead of directly create the text files while collecting, we can store the data in some data structure.
I think that the best storing will be XML (or INI ), and not a one-time array variable, which will be relevant only during the macro execution.
Then, if I wish to add a single entry later, to an existing property, it'll know how and where to do that.
With this way, the algorithm should be:

* create an xml object
* for every line, check if a tag for its property id exists. If not, create it. (in INI, I remember you use the same command and it does it by itself)
* If the property has no owner, id, etc. tags, add them
* add the sign
* after processing all the sheet, save and close the xml object
* read from the xml by a loop, and print properties data to separate files


xml example:
[vba]
<Property id="166143000003">

<BusinessName>Paz</BusinessName>
<OwnerID>510216054</OwnerID >
<PropertyID>166143000003</PropertyID>
<OwnerName>Paz Company Ltd.</OwnerName>
<OwnerAddress>P.O.B. 222 City</OwnerAddress>
<Sign id="2010004701">

<Content>Tasty Yellow</Content>
<Width>250</Width>
<Height>230</Height>
<Area>6</Area>
<AddressStreet>rd. 434</AddressStreet>
<AddressHouse>21</AddressHouse>
<Location>Display Window</Location>

</Sign>
<Sign id="2010004801">

…
…

</Sign>
etc. etc.

</Property>
<Property id="36100001550">

…
…
…

</Property>
etc.
etc.
[/vba]
Or maybe most of the sign data should be in attributes and the content inside the tag:
[vba]
<Sign id="2010004701" Width="250" Height="230" Area="6" AddressStreet="rd. 434" AddressHouse="21" Location="Display Window">
Tasty Yellow
</Sign>
[/vba]
Someone who knows to manipulate XML in VBA will need to determine
what's the better pattern.


And again: Please tell me if I should, and allowed, to start a new thread about it, because it's a whole different macro.


Thanks a lot!

[Kenneth Hobs]

I would consider the question solved so a new thread would seem to be in order. When you start a new thread, reference this one first. Please mark this thread solved if you agree that it meets your initial request.

I am not sure what an INI or XML approach would solve. Your data is already in a sort of a database format already. IF you really want a database, then why not use Access since it is part of the MSOffice Professional Suite? Of course you can still create and query DB files even if you don't have MSAccess.

The project should have probably been done in Access anyway. Relational tables would seem the best route.

If you go with XML, ChilKat, http://www.chilkatsoft.com/, might be a good tool. Of course that means that others would need it if you are designing it for them and not yourself.

In any of these other methods to parse your data, the method presented here can still be used to iterate through the Excel data.

[MeiR_ct]

I'm doing this with Excel because the company workers work with Excel for years.

I'll ask in the new thread to use DB format as you said. The problem is I'm not familiar with it at all, but maybe this is the time

Thanks once again for all of your help, Kenneth!

[MeiR_ct]

Kenneth, sorry to bother again on this thread, but I've thought on something to solve my need, and I wanted to inform and to thank you officialy
I can simply use "find" method to check whether the current handled property is the last, and if it is, to append the bottom section that I wished

[vba] ...
...
'Append now.
AppendToTXTFile s, sData
'Add Archived value.
Cells(cRow, aRange.Column).Value = True
Set fRange = Range(Cells(cRow + 1, arrayCNcol(3)), Cells(Rows.Count, arrayCNcol(3)).End(xlUp))).Find(what:=Cells(cRow, arrayCNcol(3)).Value)
If fRange Is Nothing Then
sData = "Some more text..."
sData = sData & vbCrlf & "End of report for: " & Cells(cRow, arrayCNcol(3)).Value "."
AppendToTXTFile s, sData
End If
...
...[/vba]
I've tested it and it's good =]
So at least for meanwhile, until the code that handles DB is done, we will use this one, because the company workers want already to start creating the reports.

Thanks to you, I was able to write some vba code, by myself!
So again: Thanks a lot!