VBA - Overflow Error

[berwicks]

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?

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.

 

[Gary McMaster]

I don't see anything in this code that has anything to do with XML. Exactly what are you trying to do and what version of XL are you using.

Gary

 

[berwicks]

Hi,

The code is designed to create the XML structure on a blank excel worksheet and then it is moved manually into an XML editor.

All of the strings etc are burried within the code, but looking at the post again, all of the XML tags appear to have been dropped when I posted the code.

I used the 'Code' wrap before I pasted the code in, so I am not sure what happened to the tags. I have also tried pasting using the 'PHP' wrap, but it still drops the XML.

Is there any other way to send the code over to you?

 

[Gary McMaster]

I sent you a PM with my email address. All I have is XL2000. If it's one of the newer versions you may have to shorten it and save it back to an older version.

I don't know a lot about XML but I'll take a look if I can open the file.

Gary

 

[Gary McMaster]

Maybe try wrapping the code in the HTML tags. I believe XML uses the same symbols as HTML.

Gary

 

[Norie]

Where do you get the error in the code?

Does it occur immediately, straight away or at a after a specific number of iterations of the loop?