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]

One cause of an overflow error is trying to assign a value greater than 32767 to an integer. A quick thing to try, if the sheet is large, is change your integer vars to longs.

Gary

 

[berwicks]

Hi,

Tried this and got the same error. I then changed the ints to strings to see if that made a differnece and got a new error:

'Run-time error '1004':

Application-defined or object defined error'

If I change back to ints I get overflow errors agin.

Please help!

 

[Norie]

Try Long (integer) instead of Integer.

 

[Gary McMaster]

The 3rd line of your 'codes to check for special characters seems to have extra quotes.

Maybe try using chr(34) & chr(34) instead of quoting quotes or to start maybe simply comment that line and see if the error disappears.

Gary

 

[berwicks]

Hi Gary,

No luck, still getting on overflow error.

Is there anyway for me to upload the excel file so you can see it in contex?

Thanks

 

[Gary McMaster]

I don't have any data but the code runs and gives me an error here:

intRowC = intRowC + 1

The value of the variable (intRowC) at that point is more than an integer can hold.

Gary

 

[berwicks]

Hi,

When I change intRowC to Long from and Integer I get the 1004 error.

I'm really lost with this now.

 

[Gary McMaster]

When I change intRowC to Long from and Integer I get the 1004 error.

So do I. It is trying to address more than 64K rows which I do not have (XL2000).

Gary

 

[berwicks]

Thanks, any suggestions on how to stop it doing this?