Scribd
Upload
18 views

Reciept Generation Code Final

This VBA macro takes data from a worksheet, constructs XML strings, appends them to a full output string, and then writes the full output string to another worksheet and/or an XML file. It iterates through rows of data on Sheet1, builds XML tags with the data, and adds it to the full output. It then clears the original data ranges on Sheet1 and writes the full output to Sheet2 or an XML file selected by the user.

Uploaded by

Riel Rahman
Copyright
© © All Rights Reserved
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
18 views

Reciept Generation Code Final

This VBA macro takes data from a worksheet, constructs XML strings, appends them to a full output string, and then writes the full output string to another worksheet and/or an XML file. It iterates through rows of data on Sheet1, builds XML tags with the data, and adds it to the full output. It then clears the original data ranges on Sheet1 and writes the full output to Sheet2 or an XML file selected by the user.

Uploaded by

Riel Rahman
Copyright
© © All Rights Reserved
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 2

Sub Generate_Click()

Dim ws1 As Worksheet


Dim ws2 As Worksheet
Dim lastRow As Long
Dim XMLString As String
Dim FullOutput As String
Dim FilePath As String
Dim FileNum As Integer
Dim rowIndex As Long

' Set references to Sheet1 and Sheet2


Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")

' Find the last used row in column A of Sheet1


lastRow = ws1.Cells(ws1.Rows.Count, "B").End(xlUp).Row

' Iterate through each row from B5 to the last used row or the 1000th row
For rowIndex = 5 To WorksheetFunction.Min(lastRow, 1000)
' Check if B, C, and D are filled in Sheet1
If ws1.Range("B" & rowIndex).Value <> "" And ws1.Range("C" &
rowIndex).Value <> "" And ws1.Range("D" & rowIndex).Value <> "" Then
' Construct the XML string
XMLString = "<TALLYMESSAGE xmlns:UDF=""TallyUDF"">" & vbCrLf & _
" <VOUCHER REMOTEID="""" VCHTYPE=""Receipt""
ACTION=""Create"" OBJVIEW=""Accounting Voucher View"">" & vbCrLf & _
" <DATE>" & ws1.Range("B" & rowIndex).Value &
"</DATE>" & vbCrLf & _
" <PARTYLEDGERNAME>" & ws1.Range("C" &
rowIndex).Value & "</PARTYLEDGERNAME>" & vbCrLf & _
" <LEDGERNAME>" & ws1.Range("C" & rowIndex).Value &
"</LEDGERNAME>" & vbCrLf & _
" <VOUCHERNUMBER/>" & vbCrLf & _
" <VOUCHERKEY>192427419762696</VOUCHERKEY>" & vbCrLf
& _
" <ALLLEDGERENTRIES.LIST>" & vbCrLf & _
" <LEDGERNAME>" & ws1.Range("C" &
rowIndex).Value & "</LEDGERNAME>" & vbCrLf & _
" <ISPARTYLEDGER>Yes</ISPARTYLEDGER>" & vbCrLf &
_
" <AMOUNT>" & ws1.Range("D" & rowIndex).Value &
"</AMOUNT>" & vbCrLf & _
" </ALLLEDGERENTRIES.LIST>" & vbCrLf & _
" <ALLLEDGERENTRIES.LIST>" & vbCrLf & _
" <LEDGERNAME>Cash</LEDGERNAME>" & vbCrLf & _
" <ISDEEMEDPOSITIVE>Yes</ISDEEMEDPOSITIVE>" &
vbCrLf & _
" <ISPARTYLEDGER>Yes</ISPARTYLEDGER>" & vbCrLf &
_
"
<ISLASTDEEMEDPOSITIVE>Yes</ISLASTDEEMEDPOSITIVE>" & vbCrLf & _
" <AMOUNT>-" & ws1.Range("D" & rowIndex).Value &
"</AMOUNT>" & vbCrLf & _
" </ALLLEDGERENTRIES.LIST>" & vbCrLf & _
" </VOUCHER>" & vbCrLf & _
"</TALLYMESSAGE>"

' Append the XML string to the FullOutput


FullOutput = FullOutput & XMLString & vbCrLf
End If
Next rowIndex

' Clear the existing content in Sheet2


ws2.Range("A5:A1000").ClearContents

' Split FullOutput into an array


Dim OutputArray() As String
OutputArray = Split(FullOutput, vbCrLf)

' Transpose the array and assign it to the range


For rowIndex = LBound(OutputArray) To UBound(OutputArray)
ws2.Cells(rowIndex + 5, 1).Value = OutputArray(rowIndex)
Next rowIndex

' Clear the data from column B, C, and D starting from row 5 to the declared
range
Dim clearRange As Range
Set clearRange = ws1.Range("B5:D" & lastRow)
clearRange.ClearContents

' Ask user to save as XML file


FilePath = Application.GetSaveAsFilename(InitialFileName:=Format(Date, "ddmmyy") &
"_ledger_carefull_to_select_tally_company", FileFilter:="XML Files (*.xml), *.xml")

' Check if the user canceled the operation


If FilePath <> "False" Then
' Open a new text file
FileNum = FreeFile()
Open FilePath For Output As #FileNum
' Write the full output to the text file
Print #FileNum, FullOutput
' Close the text file
Close #FileNum
End If
End Sub

You might also like