Excel to XML: Performance increase

Question

I would like to ask somebody if he have any idea how to make this code go faster. Currently in case of large data (over 180 000 lines / 39 columns) it takes approx 5:50 hours to generate all code in case of using MS Excel 2007.

I would be happy for any advice.

Sub TOXML()

    strChoosenFile = InputBox("Write number of file which you want generate.", "Choose sheet for generation XML")

    Worksheets("time").Cells(1, 1) = Now

    Application.ScreenUpdating = False

    Dim lngRow As Long
    Dim strInsetText$

    lngRow = 1

    RowsInSource = Worksheets(strChoosenFile).Range("A300000").End(xlUp).Row - 2
    ColumnsInSource = Worksheets(strChoosenFile).Range("DD2").End(xlToLeft).Column

    For i = 1 To RowsInSource

        strInsetText = "<R>"

        For x = 1 To ColumnsInSource

            strInsetText = strInsetText & "<S>" & Worksheets(strChoosenFile).Cells(i + 2, x).Text & "</S>"

        Next x

        strInsetText = strInsetText & "</R>"

        Worksheets(strChoosenFile & "-XML").Cells(lngRow, 1) = strInsetText

        lngRow = lngRow + 1
        strInsetText = ""

    Next i

    Worksheets("time").Cells(1, 2) = Now

    Application.ScreenUpdating = True

    MsgBox "Done: " & i - 1

End Sub

iDevlop · Answer 1 · 2014-04-25T13:08:46.800

1

Suggestion: try to move the worksheet data to an array:

dim ar() as variant
ar = Worksheets(strChoosenFile).Range("A1").CurrentRegion  'or any range selection method

Then work with array elements instead of cells. This will minimize exchanges between VBA and the worksheet, which are expensive (in terms of performance).
Similarly, you could also load whole rows instead of cells.

edited Apr 25 '14 at 13:08

answered Apr 25 '14 at 09:09

iDevlop

24,841
11
90
149

score 1 · Accepted Answer · edited May 23 '17 at 12:04

Try this code. It takes only 15 sec on my machine (for 180 000 lines / 39 columns)

Sub TOXML()
    Dim strChoosenFile
    Dim lngRow As Long, RowsInSource As Long, ColumnsInSource As Long, i As Long, x As Long
    Dim strInsetText As String
    Dim arr
    Dim res() As String

    strChoosenFile = InputBox("Write number of file which you want generate.", "Choose sheet for generation XML")

    Worksheets("time").Cells(1, 1) = Now
    Application.ScreenUpdating = False

    With Worksheets(strChoosenFile)
        RowsInSource = .Range("A300000").End(xlUp).Row - 2
        ColumnsInSource = .Range("DD2").End(xlToLeft).Column
        'write all values in array
        arr = .Range(.Cells(3, 1), .Cells(RowsInSource + 2, ColumnsInSource)).Value
    End With
    'Redim array for result, note that I'm using 2D array,
    'because I want to get "Column" array, rather than "Row" array
    ReDim res(1 To RowsInSource, 1 To 1)

    For i = 1 To RowsInSource
        res(i, 1) = "<R>"
        For x = 1 To ColumnsInSource
            res(i, 1) = res(i, 1) & "<S>" & arr(i, x) & "</S>"
        Next x
        res(i, 1) = res(i, 1) & "</R>"
    Next i
    'write result of array on the sheet
    Worksheets(strChoosenFile & "-XML").Cells(1, 1).Resize(UBound(res)).Value = res
    Worksheets("time").Cells(1, 2) = Now

    Application.ScreenUpdating = True
    MsgBox "Done: " & i - 1
End Sub

Also I'm not sure why do you hardcoded .Range("A300000") and .Range("DD2") (maybe you need it), but read also: How to determine last used row/column

I completly forgot that I can convert it into array. It's huge improvement. Thank you a lot **simoco**. I will take a look also on the link you passed below. — Sinogard, Apr 25 '14 at 12:05
**simoco** one more thing. It's possible somehow in array keep values as they was formatted? Currently they are written in the way they was stored. — Sinogard, Apr 25 '14 at 14:49
@Sinogard, I'm afraid no, only way is to loop and populate array with `Cells(i,j).Text`. However I don't suggest you to go this way, since `Text` property is _very_ slow. It'd be better to reformat your data somehow — Dmitry Pavliv, Apr 25 '14 at 17:45

Excel to XML: Performance increase

2 Answers2