Help with Loop

[Roller]

Hello all, I am looking for some guidance for performing a loop to essentially concatenate data from a range of cells into an output file. I have written code that writes (exports) a *.txt file for all data entered into worksheet. Each row of data is a separate check payment to various vendors so the data is very simple: Name, address, check amount, and data from the invoice. The limitation with what I've built is each row is a single payment record and the macro writes each row into the *.txt file in the same order it was input into the worksheet.

I want to expand the use of this worksheet to provide the users of this worksheet to add multiple invoices to a single payment. Functionally, the user just adds the necessary data in the corresponding columns for the data they are adding while leaving the other fields (i.e. name, address, amount) blank. If I use check number as the key field that links the records together, how can I perform a loop for to count the number of times the check number field is the same so I can use the loop to concatenate the data fields and then move on to the next payment. Each payment can have 0 additional records or up to 2400 (unlikely but that is the system max).

I have a constraint that all this data must be concatenated in the output file.

I cannot seem to identify how many additional records are present for a given payment. I plan to use this variable amount in the .offset( ) to get the correct cell reference. Thanks in advance for your consideration. ​

 

[DanteAmor]

You can put a sample of your data using the XL2BB tool, you can use generic values.
Explain what data you want to take and put in the output file.
And it is also important that you show in another cell range or an image the result that you need.

 

[Roller]

Here is my data set... Concentrating on columns S, T, U V and W which are labeled Remit 1 - 5. I need to concatenate those columns on rows 2, 3 and 4 in the export file. Row 5 is exported without any concatenating. Rows 6 and 7 need concatenating, and row 8 exports by itself. Not sure if the row and column markers are showing but in my sample data, but we can expect related rows of data to be in a continuous section themselves. There won't be rows of data scattered within the worksheet.

TRUE	Check No.	Payee Name 1	Payee Name 2 [optional]	Check Date	Amount	Account		Address Line1		City	State or Province	Zip						10-Remit 1 EG: Invoice Dt	20-Remit 2 EG: Invoice #	13-Remit 3 EG: Inv Amount	12-Remit 4 EG: Discount	25-Remit 5 EG: Description
	1234				100.00													4/10/2020	555-asdf2	50,000,000.00	0	supplies
	1234																	3/10/2020	556-asdf2	350.27	0	supplies
	1234																	12/10/2019	550-asdf2	4452.00	0	supplies
	2345				200.00
	3456				300.00													3/31/2020	5648872	250.00	50.00	repairs
	3456																	3/30/2020	5648789	100.00	0	repairs
	4567				400.00													4/15/2020	120bpr	1355.00	0	Q1 941

The resulting output should look like: (this is the text file output and the remittance info ended up wrapping because of my window size - the results should be a long text string of spaces and characters).

<PayeeName1></PayeeName1>
<PayeeName2></PayeeName2>
<PostAddr>
<Addr1></Addr1>
<Addr2></Addr2>
<City></City>
<StateProv></StateProv>
<PostalCode></PostalCode>
<Country></Country>
</PostAddr>
<RemittanceInfo> 4/10/2020 555-asdf2 supplies 50,000,000.00 0{crlf}
				3/10/2020 556-asdf2 supplies 350.27 0{crlf}
12/10/2019 550-asdf2 supplies 4452.00 0</RemittanceInfo>
</XferInfo>
</XferAddRq>
</BankSvcRq>
</CMA>
<RemittanceInfo> 3/31/2020 5648872 repairs 250.00 50.00{crlf}
3/30/2020 5648789 repairs 100.00 0</RemittanceInfo>
</XferInfo>
</XferAddRq>
</BankSvcRq>
</CMA>
<RemittanceInfo> 4/15/2020 120bpr Q1 941 1355.00 0</RemittanceInfo>
</XferInfo>
</XferAddRq>
</BankSvcRq>
</CMA>
<BATCHTRAILER>4</BATCHTRAILER>

 

[DanteAmor]

Ok, there are several things that you did not mention and I deduced or assumed from the images:
- I don't understand the first few rows of the output file.
- I understand rows 2,3 and 4 (or I think).
- I don't understand what you mean by rows 5,6,7 and 8.
- The data to concatenate, apparently have spaces (10, 20, 13, 12, 25) are the lengths of the fields?
- The output of columns S, T, U V, W, it seems that they are in this order S, T, W, U, V, is it correct?

But I give you the following macro. Generate a "txtfile.txt" file in the same folder where you have the macro file.

We can start with that, check if it is close to what you need.

Sub Output_Txt()
  Dim a As Variant, dic As Object
  Dim i As Long, j As Long
  Dim cad As String, sFile As String, n As Integer
 
  sFile = ThisWorkbook.Path & "\" & "txtfile.txt"
  iFile = FreeFile
  Open sFile For Output As #iFile
 
  Set dic = CreateObject("Scripting.Dictionary")
  a = Range("B2:W" & Range("B" & Rows.Count).End(3).Row + 1).Value
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      dic(a(i, 1)) = Empty
      If Right(cad, 6) = "{crlf}" Then
        cad = Mid(cad, 1, Len(cad) - 6) & "</RemittanceInfo>"
      End If
      cad = "<RemittanceInfo>"
    End If
    If a(i, 18) & a(i, 19) & a(i, 20) & a(i, 21) & a(i, 21) <> "" Then
      cad = cad & Space(10 - Len(a(i, 18))) & a(i, 18)
      cad = cad & Space(20 - Len(a(i, 19))) & a(i, 19)
      cad = cad & Space(25 - Len(a(i, 22))) & a(i, 22)
      cad = cad & Space(13 - Len(a(i, 20))) & a(i, 20)
      cad = cad & Space(12 - Len(a(i, 21))) & a(i, 21)
      cad = cad & "{crlf}"
    End If
  Next i
  Close #iFile
End Sub

 

[Roller]

Thank you for your help. Somehow, I am getting a blank text file when I run your codes, but let me address your questions (in order):
- The first few rows of the output file are irrelevant to this issue, and my code, as is, works fine if each payment (row of data) was unique and only had the remittance fields on the same row.
- To confirm, the rows 2, 3, and 4 is one payment but there are 3 rows of remittance data needed to be sent with that payment record (amounts don't match but are irrelevant) in the output file.
- Row 5 is the one payment of $200 without any remittance data (blank field in output is ok)
- Rows 6 and 7 are 1 payment but there are 2 rows of remittance data to be sent with that payment record in the output file
- The order was switched on purpose but is irrelevant to this issue (theoretically, our customers can choose the order of the fields and how they want them exported.

Here's what the output file should look like for each of the records above (Since there are only 4 unique check numbers, there are only 4 remittance records associated with each payment:
Please note that I removed all the extra spaces just for viewing sake. You were corrected about the field size, but I'm okay with that line of code, too.
For #1234: <RemittanceInfo> 4/10/2020 555-asdf2 supplies 50,000,000.00 0{crlf} 3/10/2020 556-asdf2 supplies 350.27 0{crlf}12/10/2019 550-asdf2 supplies 4452.00 0</RemittanceInfo>
For #2345: <RemittanceInfo></RemittanceInfo>
for #3456: <RemittanceInfo> 3/31/2020 5648872 repairs 250.00 50.00{crlf} 3/30/2020 5648789 repairs 100.00 0</RemittanceInfo>
For #4567: <RemittanceInfo> 4/15/2020 120bpr Q1 941 1355.00 0</RemittanceInfo>

So the loop part has to recognize that any subsequent remit fields are to be appended to the first 5 fields on the original row as long as the check # fields are the same. So (to grossly simplify), the logic is:
- Reads row 2 and loops row 3 and 4, write row 2 record (w/appended data) to file
- reads row 5, write row 5 to file
- reads row 6 and loops row 7, write row 2 record

(w/appended data) ​

to file
- reads row 7, write row 7 to file

Hope these requirements are clearer. Thank you.

 

[DanteAmor]

I am getting a blank text file when I run your codes

Before continuing I need to know that the macro generates a file with data.
According to your image, the data must be in this structure:

varios 01may2020 vlookup across sheets.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W
1		Check No.	Payee Name 1	Payee Name 2 [optional]	Check Date	Amount	Account		Address Line1		City	State or Province	Zip						10-Remit 1 EG: Invoice Dt	20-Remit 2 EG: Invoice #	13-Remit 3 EG: Inv Amount	12-Remit 4 EG: Discount	25-Remit 5 EG: Description
2		1234				100													10-abr	555-asdf2	50000000	0	supplies
3		1234																	10-mar	556-asdf2	350.27	0	supplies
4		1234																	10-dic	550-asdf2	4452	0	supplies
5		2345				200
6		3456				300													31-mar	5648872	250	50	repairs
7		3456																	30-mar	5648789	100	0	repairs
8		4567				400													15-abr	120bpr	1355	0	Q1 941
datos html

If the sheet structure is not like that, then we should start with that.
Put examples here using XL2BB tool.

 

[Roller]

Yes, sorry. My macro does write a file and otherwise works well if there's only one row of data for each payment. Here's the code that I have that works for 1 row of remittance data.
The worksheet structure is exactly how you have it above with the exception that on the initial row of any payment, the name/address and all other fields will be populated (since I had personal data I removed it for privacy). If there are additional rows needed for remittance data, then the check number field will be the same (i.e. that's the key) and only the remit fields will be populated.

Sub ExportToXML()
Dim Filename As Range
Dim FSO As Object
Dim XML As Object

Application.Run "Module1.INPReplaceText"

Set FSO = CreateObject("Scripting.FileSystemObject")
With Sheets("CheckDataInput")
'this saves the file to the same path and same file name as the orig doc and overwrites it
Set XML = FSO.CreateTextFile(Filename:=ThisWorkbook.Path & "\" & "PCBGI" & "." & Sheets("ReferenceTab").Range("CustPermID").Value _
& "." & Sheets("ReferenceTab").Range("BatchNo").Value & ".xml", Overwrite:=True)
'this formats the data into XML format with aggregators lines
XML.writeline ("<BATCHHEADER>" & Sheets("ReferenceTab").Range("BatchNo").Value & "</BATCHHEADER>")
For Each Filename In .Range("B2:B" & GetLastRow("CheckDataInput"))
With Filename
XML.writeline ("<?xml version=""1.0"" encoding=""utf-8""?>")
XML.writeline (" <CMA>")
XML.writeline (" <BankSvcRq>")
XML.writeline (" <RqUID>" & Sheets("ReferenceTab").Range("RqUID").Value & "</RqUID>")
XML.writeline (" <XferAddRq>")
XML.writeline (" <RqUID>" & Sheets("ReferenceTab").Range("RqUID").Value & "</RqUID>")
XML.writeline (" <PmtRefId>" & .Offset(0, 0).Value & "</PmtRefId>")
XML.writeline (" <ChkNum>" & .Offset(0, 0).Value & "</ChkNum>")
XML.writeline (" <CustId>")
XML.writeline (" <SPName>" & Sheets("ReferenceTab").Range("SPName").Value & "</SPName>")
XML.writeline (" <CustPermId>" & Sheets("ReferenceTab").Range("CustPermId").Value & "</CustPermId>")
XML.writeline (" </CustId>")
XML.writeline (" <XferInfo>")
XML.writeline (" <DepAcctIdFrom>")
XML.writeline (" <AcctId>" & Format(.Offset(0, 5).Value, "0000000000") & "</AcctId>")
XML.writeline (" <AcctType>" & Sheets("ReferenceTab").Range("AcctType").Value & "</AcctType>")
XML.writeline (" <Name>" & Sheets("ReferenceTab").Range("Name").Value & "</Name>")
XML.writeline (" <BankInfo>")
XML.writeline (" <BankIdType>" & Sheets("ReferenceTab").Range("BankIdType").Value & "</BankIdType>")
XML.writeline (" <BankId>" & Sheets("ReferenceTab").Range("BankId").Value & "</BankId>")
XML.writeline (" </BankInfo>")
XML.writeline (" </DepAcctIdFrom>")
XML.writeline (" <CustPayeeInfo>")
XML.writeline (" <PayeeName1>" & .Offset(0, 1).Value & "</PayeeName1>")
XML.writeline (" <PayeeName2>" & .Offset(0, 2).Value & "</PayeeName2>")
XML.writeline (" <PostAddr>")
XML.writeline (" <Addr1>" & .Offset(0, 7).Value & "</Addr1>")
XML.writeline (" <Addr2>" & .Offset(0, 8).Value & "</Addr2>")
XML.writeline (" <City>" & .Offset(0, 9).Value & "</City>")
XML.writeline (" <StateProv>" & .Offset(0, 10).Value & "</StateProv>")
If Len(Filename.Offset(0, 11).Value) = 9 Then
XML.writeline (" <PostalCode>" & Format(.Offset(0, 11).Value, "00000-0000") & "</PostalCode>")
Else
XML.writeline (" <PostalCode>" & Format(.Offset(0, 11).Value, "00000") & "</PostalCode>")
End If
XML.writeline (" <Country>" & .Offset(0, 12).Value & "</Country>")
XML.writeline (" </PostAddr>")
XML.writeline (" </CustPayeeInfo>")
XML.writeline (" <CurAmt>")
XML.writeline (" <Amt>" & .Offset(0, 4).Value & "</Amt>")
XML.writeline (" <CurCode>" & Sheets("ReferenceTab").Range("CurCode").Value & "</CurCode>")
XML.writeline (" </CurAmt>")
XML.writeline (" <DueDt>" & Format(.Offset(0, 3).Value, "yyyy-mm-dd") & "</DueDt>")
XML.writeline (" <Category>" & Sheets("ReferenceTab").Range("Category").Value & "</Category>")
XML.writeline (" <MailInfo>")
XML.writeline (" <MailType>" & .Offset(0, 6).Value & "</MailType>")
XML.writeline (" </MailInfo>")
XML.writeline (" <RefInfo>")
XML.writeline (" <RefType>Originator to Beneficiary 1</RefType>")
XML.writeline (" <RefId>" & .Offset(0, 13).Value & "</RefId>")
XML.writeline (" </RefInfo>")
XML.writeline (" <RefInfo>")
XML.writeline (" <RefType>Originator to Beneficiary 2</RefType>")
XML.writeline (" <RefId>" & .Offset(0, 14).Value & "</RefId>")
XML.writeline (" </RefInfo>")
XML.writeline (" <RefInfo>")
XML.writeline (" <RefType>Originator to Beneficiary 3</RefType>")
XML.writeline (" <RefId>" & .Offset(0, 15).Value & "</RefId>")
XML.writeline (" </RefInfo>")
XML.writeline (" <RefInfo>")
XML.writeline (" <RefType>Originator to Beneficiary 4</RefType>")
XML.writeline (" <RefId>" & .Offset(0, 16).Value & "</RefId>")
XML.writeline (" </RefInfo>")
XML.writeline (" <RemittanceInfo>" & .Offset(0, 17).Value & " & .Offset(0, 18).Value & " & .Offset(0, 21).Value & "" _
& .Offset(0, 19).Value & "" & .Offset(0, 20).Value & "</RemittanceInfo>")
XML.writeline (" </XferInfo>")
XML.writeline (" </XferAddRq>")
XML.writeline (" </BankSvcRq>")
XML.writeline (" </CMA>")
End With
Next Filename
XML.writeline ("<BATCHTRAILER>" & Sheets("ReferenceTab").Range("BatchCount").Value & "</BATCHTRAILER>")
XML.Close


End With

Set XML = Nothing
Set FSO = Nothing
End Sub

Function GetLastRow(wkSheet As String) As Long
With Worksheets(wkSheet)
GetLastRow = .Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End With
End Function

Sub INPReplaceText()
Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long
fndList = Array("&", "'", "^")
rplcList = Array("&amp;", "&apos;", "{crlf}")
For x = LBound(fndList) To UBound(fndList)
For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht
Next x
End Sub

 

[Roller]

Sorry, and I want to apologize in advance for hastily posting the Code. I was in the process of posting the code above and inadvertently sent the post without finishing my comments on my approach... I was thinking that a simple loop inserted around the orange text above would be where to "expand" the functionality of the worksheet. I'm still trying to apply your code from above to this section. Thanks again.

 

[DanteAmor]

But I wasn't referring to your macro, I was referring to my macro. If my macro generates records with the test data that I put.

 

[Roller]

Sorry, misunderstood. You macro generated an empty file.