Hi,
I am really new to writing code in VBA and the code below is meant to convert information on Goods Received Notes into XML for posting into a legacy system.
Each line in Excel contains details of the individual GRN for up to three order lines. The macro should then take this data and create an appropriate XML file.
I was getting a loop error, but after some digging on this site I resolved that, but now I am getting an overflow error.
Can someone please have a look at my code and let me know where I am going wrong?
Thank you.
I am really new to writing code in VBA and the code below is meant to convert information on Goods Received Notes into XML for posting into a legacy system.
Each line in Excel contains details of the individual GRN for up to three order lines. The macro should then take this data and create an appropriate XML file.
I was getting a loop error, but after some digging on this site I resolved that, but now I am getting an overflow error.
Can someone please have a look at my code and let me know where I am going wrong?
Code:
Sub GenerateXML()
'
Dim intRowS As Integer, intRowC As Integer, intRowC2 As Integer, intRowD As Integer
Dim strTab As String, strTab2 As String, tempco As String
intRowS = 10 'row count on DataEntry Sheet
intRowC = 3 'row count on GenCode Sheet
intRowC2 = 3
intRowS2 = 6
intRowS3 = 5
intRowS4 = 4
intRowS5 = 3
strTab = "GenCode"
strTab2 = "DataEntry"
tempco = ""
'codes to check for special characters
Worksheets(strTab2).Range("A10", "Y1100").Replace What:="&", Replacement:="&", SearchOrder:=xlByColumns, MatchCase:=True
Worksheets(strTab2).Range("A10", "Y1100").Replace What:="'", Replacement:="'", SearchOrder:=xlByColumns, MatchCase:=True
Worksheets(strTab2).Range("A10", "Y1100").Replace What:="""", Replacement:=""", SearchOrder:=xlByColumns, MatchCase:=True
Worksheets(strTab2).Range("A10", "Y1100").Replace What:="<", Replacement:="<", SearchOrder:=xlByColumns, MatchCase:=True
Worksheets(strTab2).Range("A10", "Y1100").Replace What:=">", Replacement:=">", SearchOrder:=xlByColumns, MatchCase:=True
Sheets(strTab).Select
Cells.Select
Selection.ClearContents
Worksheets(strTab).Cells(1, 1) = "<?xml version=""1.0"" encoding=""UTF-8""?>"
Worksheets(strTab).Cells(2, 1) = "<ReceiptReturnImport>"
Worksheets(strTab).Cells(intRowC, 2) = "<ReceiptReturnRequest batchID=""" & Worksheets(strTab2).Cells(intRowS2, 2) & """ batchDate=""" & Worksheets(strTab2).Cells(intRowS3, 2) & """>"
intRowC = intRowC + 1
Worksheets(strTab).Cells(intRowC, 2) = "<Login>"
intRowC = intRowC + 1
Worksheets(strTab).Cells(intRowC, 2) = "<UserID>" & Worksheets(strTab2).Cells(intRowS5, 2) & "</UserID>"
intRowC = intRowC + 1
Worksheets(strTab).Cells(intRowC, 2) = "<Password>" & Worksheets(strTab2).Cells(intRowS4, 2) & "</Password></Login>"
intRowC = intRowC + 1
Do Until (Worksheets(1).Cells(intRowS, 1)) = "End"
If Not IsEmpty(Worksheets(1).Cells(intRowS, 1)) Then
Worksheets(strTab).Cells(intRowC, 3) = "<PurchaseOrder poNumber=""" & Worksheets(strTab2).Cells(intRowS, 1) & """>"
intRowC = intRowC + 1
End If
Worksheets(strTab).Cells(intRowC, 3) = "<Receipt packingSlipNumber=""" & Worksheets(strTab2).Cells(intRowS, 2) & """ date =""" & Worksheets(strTab2).Cells(intRowS3, 2) & """ status=""1001"">"
intRowC = intRowC + 1
If Not IsEmpty(Worksheets(strTab2).Cells(intRowS, 3)) Then
Worksheets(strTab).Cells(intRowC, 3) = "<ReceiptLine number=""" & Worksheets(strTab2).Cells(intRowS, 3) & """ status=""1001"">"
intRowC = intRowC + 1
If Not IsEmpty(Worksheets(strTab2).Cells(intRowS, 3)) Then
Worksheets(strTab).Cells(intRowC, 4) = "<Line>"
intRowC = intRowC + 1
End If
If Not IsEmpty(Worksheets(strTab2).Cells(intRowS, 3)) Then
Worksheets(strTab).Cells(intRowC, 4) = "<ItemNumber>" & Worksheets(strTab2).Cells(intRowS, 4) & "</ItemNumber>"
intRowC = intRowC + 1
End If
If Not IsEmpty(Worksheets(strTab2).Cells(intRowS, 3)) Then
Worksheets(strTab).Cells(intRowC, 4) = "<ReceiptReturnValue type=""quantity"">" & Worksheets(strTab2).Cells(intRowS, 5) & "</ReceiptReturnValue>"
intRowC = intRowC + 1
End If
If Not IsEmpty(Worksheets(strTab2).Cells(intRowS, 3)) Then
Worksheets(strTab).Cells(intRowC, 3) = "</Line></ReceiptLine>"
intRowC = intRowC + 1
End If
If Not IsEmpty(Worksheets(strTab2).Cells(intRowS, 6)) Then
Worksheets(strTab).Cells(intRowC, 4) = "<ReceiptLine number=""" & Worksheets(strTab2).Cells(intRowS, 6) & """ status=""1001"">"
intRowC = intRowC + 1
End If
If Not IsEmpty(Worksheets(strTab2).Cells(intRowS, 6)) Then
Worksheets(strTab).Cells(intRowC, 4) = "<Line>"
intRowC = intRowC + 1
End If
If Not IsEmpty(Worksheets(strTab2).Cells(intRowS, 6)) Then
Worksheets(strTab).Cells(intRowC, 4) = "<ItemNumber>" & Worksheets(strTab2).Cells(intRowS, 7) & "</ItemNumber>"
intRowC = intRowC + 1
End If
If Not IsEmpty(Worksheets(strTab2).Cells(intRowS, 6)) Then
Worksheets(strTab).Cells(intRowC, 4) = "<ReceiptReturnValue type=""quantity"">" & Worksheets(strTab2).Cells(intRowS, 8) & "</ReceiptReturnValue>"
intRowC = intRowC + 1
End If
If Not IsEmpty(Worksheets(strTab2).Cells(intRowS, 6)) Then
Worksheets(strTab).Cells(intRowC, 3) = "</Line></ReceiptLine>"
intRowC = intRowC + 1
End If
If Not IsEmpty(Worksheets(strTab2).Cells(intRowS, 9)) Then
Worksheets(strTab).Cells(intRowC, 3) = "<ReceiptLine number=""" & Worksheets(strTab2).Cells(intRowS, 9) & """ status=""1001"">"
intRowC = intRowC + 1
End If
If Not IsEmpty(Worksheets(strTab2).Cells(intRowS, 9)) Then
Worksheets(strTab).Cells(intRowC, 4) = "<Line>"
intRowC = intRowC + 1
End If
If Not IsEmpty(Worksheets(strTab2).Cells(intRowS, 9)) Then
Worksheets(strTab).Cells(intRowC, 4) = "<ItemNumber>" & Worksheets(strTab2).Cells(intRowS, 10) & "</ItemNumber>"
intRowC = intRowC + 1
End If
If Not IsEmpty(Worksheets(strTab2).Cells(intRowS, 9)) Then
Worksheets(strTab).Cells(intRowC, 4) = "<ReceiptReturnValue type=""quantity"">" & Worksheets(strTab2).Cells(intRowS, 11) & "</ReceiptReturnValue>"
intRowC = intRowC + 1
End If
If Not IsEmpty(Worksheets(strTab2).Cells(intRowS, 9)) Then
Worksheets(strTab).Cells(intRowC, 3) = "</Line></ReceiptLine>"
intRowC = intRowC + 1
Worksheets(strTab).Cells(intRowC, 4) = "</Receipt>"
intRowC = intRowC + 1
Worksheets(strTab).Cells(intRowC, 3) = "</PurchaseOrder>"
intRowS = intRowS + 1
End If
End If
Loop
Worksheets(strTab).Cells(intRowC + 1) = "</ReceiptReturnRequest>"
intRowC = intRowC + 1
Worksheets(strTab).Cells(intRowC + 1) = "</ReceiptReturnImport>"
intRowC = intRowC + 1
End Sub
Thank you.