Hello fellow stackholders
I have this in-efficient VBA macro where i convert rows to XMl and after that post it to a web-service. It all works fine and it post everything correctly - the problem is when the excel sheet has more than 1500 rows, then it takes forever to convert. it takes hours, if you go above 10 k lines (had a co-worker who tried).
My question: Is there a way for me to speed this up, so 10.000 rows wont take half a day?
So far my code looks like this:
Dim xDOC As DOMDocument
Dim XMLHttpRequest As XMLHTTP
Dim URL As String
' Variables for XML-bulk
Dim strXML As String
Dim varTable As Variant
Dim intRow As Integer
Dim intCol As Integer
Dim strRowElementName As String
Dim strTableElementName As String
Dim varColumnHeaders As Variant
' Set custom names
strTableElementName = "postdata"
strRowElementName = "general-journal-line"
' Select the whole table in the current sheet
Range("A7").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
' Get table data
varTable = Selection.Value
varColumnHeaders = Selection.Rows(1).Value
' Build XML
strXML = ""
strXML = strXML & "<" & strTableElementName & ">"
For intRow = 2 To UBound(varTable, 1)
strXML = strXML & "<" & strRowElementName & ">"
strXML = strXML & "<journal-template-name>KASSE</journal-template-name>"
strXML = strXML & "<journal-batch-name>" + ThisWorkbook.Sheets("SMARTapi-Opsaetning").Range("C8") + "</journal-batch-name>"
strXML = strXML & "<userid>" + Environ("computername") + "\" + Application.UserName + "</userid>"
strXML = strXML & "<account-type>G/L Account</account-type>"
For intCol = 1 To UBound(varTable, 2)
strXML = strXML & "<" & varColumnHeaders(1, intCol) & ">" & _
varTable(intRow, intCol) & "</" & varColumnHeaders(1, intCol) & ">"
Next
strXML = strXML & "</" & strRowElementName & ">"
Next
strXML = strXML & "</" & strTableElementName & ">"
Debug.Print strXML
After this i post it at a webservice:
Set XMLHttpRequest = New MSXML2.XMLHTTP
With XMLHttpRequest
.Open "POST", URL, False
.setRequestHeader "Content-Type", "text/xml; encoding='utf-8'"
.Send strXML
End With
Set xDOC = New DOMDocument
Do Until xDOC.readyState = 4
Loop
xDOC.LoadXML (XMLHttpRequest.responseText)
It all works great when there is less than 500 rows - any help to make it more efficient would be much appreciated.
EDIT: Changed the code to this, yet it is still somewhat slow.
Dim xDOC As DOMDocument
Dim XMLHttpRequest As XMLHTTP
Dim URL As String
' Variabler til XML-bulk
Dim strXML As String
Dim varTable As Variant
Dim intRow As Integer
Dim intCol As Integer
Dim strRowElementName As String
Dim strTableElementName As String
Dim varColumnHeaders As Variant
Dim strKonstant As String
' Set custom names
strTableElementName = "postdata"
strRowElementName = "general-journal-line"
' Find lines and get them before building the xml
Dim lRowCount As Long
Application.ActiveSheet.UsedRange
lRowCount = Worksheets("SMARTapi-Upload").UsedRange.Rows.Count
varTable = Range("A7", "J" + CStr(lRowCount))
varColumnHeaders = Range("A7", "J7")
strKonstant = "<" & strRowElementName & "><journal-template-name>KASSE</journal-template-name><journal-batch-name>" + ThisWorkbook.Sheets("SMARTapi-Opsaetning").Range("C8") + "</journal-batch-name><userid>" + Environ("computername") + "\" + Application.UserName + "</userid><account-type>G/L Account</account-type><balancing-account-type>G/L Account</balancing-account-type>"
' Build XML
strXML = ""
strXML = strXML & "<" & strTableElementName & ">"
For intRow = 2 To UBound(varTable, 1)
strXML = strXML & strKonstant
For intCol = 1 To UBound(varTable, 2)
strXML = strXML & "<" & varColumnHeaders(1, intCol) & ">" & _
varTable(intRow, intCol) & "</" & varColumnHeaders(1, intCol) & ">"
Next
strXML = strXML & "</" & strRowElementName & ">"
Next
strXML = strXML & "</" & strTableElementName & ">"
' HER SENDES XML MED DATA FRA TABELLEN
Set XMLHttpRequest = New MSXML2.XMLHTTP
With XMLHttpRequest
.Open "POST", URL, False
.setRequestHeader "Content-Type", "text/xml; encoding='utf-8'"
.Send strXML
End With
Set xDOC = New DOMDocument
Do Until xDOC.readyState = 4
Loop
xDOC.LoadXML (XMLHttpRequest.responseText)
Do everything that @Vityata recommends in his answer, this is all good stuff and useful in all writing endeavours.
Also, if you're looking to speed up the main loop in this (which I'd assume is where most of the delay is coming from) - there isn't a lot going on in there to slow it down. However, there are a couple of things that you repeatedly do within the loop that produce the same result each time:
strXML = strXML & "<journal-batch-name>" + ThisWorkbook.Sheets("SMARTapi-Opsaetning").Range("C8") + "</journal-batch-name>"
The above line grabs the value of cell C8 in another tab every time you start a new row. I'd assume that this doesn't actually change, so why do it every time? Grab it once and store it.
strXML = strXML & "<userid>" + Environ("computername") + "\" + Application.UserName + "</userid>"
The above line reads the computer name each row. No need. Again, do it once and store it.
You can also reduce the time taken a little more by examining the large block you build each row for the bits that never change and store the result of all of your concatenation outside the loop too.
My code would look something like this:
Dim xDOC As DOMDocument
Dim XMLHttpRequest As XMLHTTP
Dim URL As String
' Variables for XML-bulk
Dim strXML As String
Dim varTable As Variant
Dim intRow As Integer
Dim intCol As Integer
Dim strRowElementName As String
Dim strTableElementName As String
Dim varColumnHeaders As Variant
Dim CalcState As Long
Dim strC8 As String
Dim strComputerName As String
Dim strPrefix As String
CalcState = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
' Set custom names
strTableElementName = "postdata"
strRowElementName = "general-journal-line"
strC8 = ThisWorkbook.Sheets("SMARTapi-Opsaetning").Range("C8")
strComputerName = Environ("computername")
' Select the whole table in the current sheet
Range("A7").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
' Get table data
varTable = Selection.Value
varColumnHeaders = Selection.Rows(1).Value
strPrefix = "<" & strRowElementName & ">" & _
"<journal-template-name>KASSE</journal-template-name>" & _
"<journal-batch-name>" + strC8 + "</journal-batch-name>" & _
"<userid>" + strComputerName + "\" + Application.UserName + "</userid>" & _
"<account-type>G/L Account</account-type>"
' Build XML
strXML = "<" & strTableElementName & ">"
For intRow = 2 To UBound(varTable, 1)
strXML = strXML & strPrefix
For intCol = 1 To UBound(varTable, 2)
strXML = strXML & "<" & varColumnHeaders(1, intCol) & ">" & _
varTable(intRow, intCol) & "</" & varColumnHeaders(1, intCol) & ">"
Next
strXML = strXML & "</" & strRowElementName & ">"
Next
strXML = strXML & "</" & strTableElementName & ">"
Debug.Print strXML
Application.Calculation = CalcState
Application.ScreenUpdating = True
Note: I have NO idea what you're picking up from .Sheets("SMARTapi-Opsaetning").Range("C8") but I gave the variable I store it in the name strC8 - you might want to change that to something more meaningful to you.
I'll leave the Range Selection.End etc. that @Vityata talks about for you as something to look into yourself. There's no better way to learn something than researching and then doing it for yourself.
EDIT/UPDATE:
I've had a look at this, mocking up a 10,000 row, 26 column table and analysed the time taken to append the text to strXML each row and I've noticed that things really start to slow down once the strXML length exceeds 25,000 characters.
I'm sure someone here will know why, but I guess the way text is appended to a string is a new string is built copying the data from the old string together with that being appended and the longer the string is, the longer each copy takes.
When the routine I originally wrote starts, it takes a couple of a hundredths of a second to add 100 rows of data to strXML.
By the time the string is 80,000 characters in length, the time taken to add 100 more rows to strXML is 12 seconds! It gets exponentially slower.
For that reason, I suggest using an array of strings to hold your output XML, each that stops adding new data once it gets over 20,000 characters in length.
When I did this using my old i7, I could read the whole 10,000 x 26 table into the array and spit it out into the immediate window in around 3 seconds.
You'll just need to adjust the output mechanism I've build there that sends the output to the immediate window into whatever you're going to send the XML to.
Here's the adjusted code:
Dim xDOC As DOMDocument
Dim XMLHttpRequest As XMLHTTP
Dim URL As String
' Variables for XML-bulk
Dim strXML As String
Dim varTable As Variant
Dim intRow As Integer
Dim intCol As Integer
Dim strRowElementName As String
Dim strTableElementName As String
Dim varColumnHeaders As Variant
Dim CalcState As Long
Dim strC8 As String
Dim strComputerName As String
Dim strPrefix As String
Dim outputtext(10000) As String
Dim characterlimit As Long
Dim VarRw As Long
Dim VarICount As Long
characterlimit = 20000 'Don't go too much above 20,000 here or it will slow down
CalcState = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
' Set custom names
strTableElementName = "postdata"
strRowElementName = "general-journal-line"
strC8 = ThisWorkbook.Sheets("SMARTapi-Opsaetning").Range("C8")
strComputerName = Environ("computername")
' Select the whole table in the current sheet
Range("A7").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
' Get table data
varTable = Selection.Value
varColumnHeaders = Selection.Rows(1).Value
strPrefix = "<" & strRowElementName & ">" & _
"<journal-template-name>KASSE</journal-template-name>" & _
"<journal-batch-name>" + strC8 + "</journal-batch-name>" & _
"<userid>" + strComputerName + "\" + Application.UserName + "</userid>" & _
"<account-type>G/L Account</account-type>"
' Build XML
strXML = "<" & strTableElementName & ">"
VarRw = 0
For intRow = 2 To UBound(varTable, 1)
If Len(strXML) > characterlimit Then
outputtext(VarRw) = strXML
VarRw = VarRw + 1
strXML = ""
End If
strXML = strXML & strPrefix
For intCol = 1 To UBound(varTable, 2)
strXML = strXML & "<" & varColumnHeaders(1, intCol) & ">" & _
varTable(intRow, intCol) & "</" & varColumnHeaders(1, intCol) & ">"
Next
strXML = strXML & "</" & strRowElementName & ">"
Next
strXML = strXML & "</" & strTableElementName & ">"
outputtext(VarRw) = strXML
For VarICount = 0 To VarRw
Debug.Print outputtext(VarICount)
Next
Application.Calculation = CalcState
Application.ScreenUpdating = True