CODEWITHSUNDEEP
vbaexcel
user2271875
user2271875

Reputation: 325

What is the Most Efficient Way to Append Several Lines to Excel Table Using VBA?

I am parsing an XML file and choosing/assigning values to a custom class list. What I'm doing now is looping through the list to append to an Excel table (listobject). Here is a simplified example:

Private employee as New employee_Class

...

ProcessXML()

employee.GoToFirst    

Do  
  Set newRow = myTable.ListRows.Add
  Intersect(newRow.Range, myTable.ListColumns("FirstName").Range).value = employee.FirstName
  Intersect(newRow.Range, myTable.ListColumns("LastName").Range).value = employee.LastName

  '... (etc., etc.)

  employee.Next

Loop Until employee.EOF

I've gotten it to work. Looping through a dozen employees is feasible, but when I have 400 or 1000 employees, it takes several minutes. I imagine it would be a lot faster to append to a run-time (non-visible) listobject and then append the run-time listobject (as a whole) to my table, but I don't know how to do that.

Secondly, I'm not sure if using Intersect is the most efficient way of appending values by column names.

Reading over 20,000 XML nodes takes a split second, but writing it (about 400-500 rows) takes about 5-10 minutes. I'm not so much concerned about syntax as I am about technique. Does anyone have a faster, more efficient technique for appending hundreds of rows to an Excel Table (ListObject)? Thanks in advance.

Upvotes: 2

Views: 4209

Answers (2)

Tim Williams
Tim Williams

Reputation: 166341

0.7 sec for 1k recs:

Sub Tester()

Dim d As Object
Dim tbl As ListObject, rw As ListRow
Dim cols, col, vals, x, t

    Set tbl = ActiveSheet.ListObjects(1)
    cols = Array("Col1", "Col2", "Col3", "Col4", "Col5", "Col6")

    'map column names to indexes...
    Set d = CreateObject("scripting.dictionary")
    For Each col In cols
        d.Add col, tbl.ListColumns(col).Index
    Next

    t = Timer
    Application.ScreenUpdating = False
    For x = 1 To 1000
        Set rw = tbl.ListRows.Add
        vals = rw.Range.Value
        vals(1, d("Col1")) = "test1"
        vals(1, d("Col2")) = "test2"
        vals(1, d("Col3")) = "test3"
        vals(1, d("Col4")) = "test4"
        vals(1, d("Col5")) = "test5"
        vals(1, d("Col6")) = "test6"
        rw.Range.Value = vals
    Next x
    Debug.Print Timer - t

End Sub

Just disabling ScreenUpdating by itself will make a big difference.

Upvotes: 4

Siphor
Siphor

Reputation: 2534

The fastest way is probably to fill the data in a array then assign the array to the range value and then resize the table. Something like (Reused Tim Williams Code) (0.6 for 10000):

Option Explicit

Sub Tester()


    Dim employeeTable As ListObject

    Set employeeTable = ActiveSheet.ListObjects(1)

    Dim columnArray As Variant
    columnArray = Array("Col1", "Col2", "Col3", "Col4", "Col5", "Col6")

    Dim dict As Object
    'map column names to indexes...
    Set dict = CreateObject("scripting.dictionary")

    Dim currentColumn As Variant
    For Each currentColumn In columnArray
        dict.Add currentColumn, employeeTable.ListColumns(currentColumn).Index
    Next

    Dim t
    t = Timer
    Application.ScreenUpdating = False

    Dim numberOfEmployees As Long
    numberOfEmployees = 10000

    Dim employeeArray As Variant
    ReDim employeeArray(1 To numberOfEmployees, 1 To employeeTable.ListColumns.Count)


    Dim i As Long
    For i = 1 To numberOfEmployees
        employeeArray(i, dict("Col1")) = "test1"
        employeeArray(i, dict("Col2")) = "test2"
        employeeArray(i, dict("Col3")) = "test3"
        employeeArray(i, dict("Col4")) = "test4"
        employeeArray(i, dict("Col5")) = "test5"
        employeeArray(i, dict("Col6")) = "test6"
    Next

    Dim numberOfTableRows As Long
    numberOfTableRows = employeeTable.ListRows.Count
    employeeTable.HeaderRowRange.Offset(numberOfTableRows + 1).Resize(numberOfEmployees).Value = employeeArray
    employeeTable.Resize employeeTable.HeaderRowRange.Resize(numberOfTableRows + numberOfEmployees + 1)

    Debug.Print Timer - t

End Sub

Upvotes: 3

Related Questions