Storing Stuff in VBA Lists

Posted on October 5, 2016 by Dick Kusleika

You no doubt recall when snb wrote about Scripting.Dictionaires. Well, there’s more.

I use Collection objects in my custom class modules almost exclusively. It’s the only object, that I know of, that I can enumerate using For Each.

Outside of custom class modules, I use Dictionary objects. I used to avoid them because they weren’t built in to the language. I was always afraid of some dependency problem. But I’ve never seen one in all my years, so I’m over that now. The advantage of the Exists property and the ability to produce an array of keys or items is awesome. it’s probably more awesome than For Each, but I just haven’t made that leap yet.

And I never use ArrayLists because I never remember them. That’s not totally true. When I’m writing a procedure with a Dictionary and I need to sort, I kick myself for not using an ArrayList.

Here’s some features of Collections, Dictionaries, and ArrayLists.

Feature	Collection	Dictionary	ArrayList
New Enum in class	Yes	No	No
Exists	No	.Exists	.Contains
Key Value paradigm	Yes	Yes	No
Unique keys	Yes	Yes	NA
Key data types	String	Any	NA
Get keys	No	Yes	NA
Auto create items	No	Yes	No
Insert anywhere	.Add(,,before,after)	No	.Insert
Output to array	No	.Keys or .Items	.ToArray

There are other differences. Those are just the ones that are important to me. If there’s a difference that’s important to you, leave a comment. You can read everything you ever wanted to know about these objects at one of the pages below:

Collections: http://www.snb-vba.eu/VBA_Collection_en.html
Dictionaries: http://www.snb-vba.eu/VBA_Dictionary_en.html
ArrayLists: http://www.snb-vba.eu/VBA_Arraylist_en.html

17 thoughts on “Storing Stuff in VBA Lists”

Felipe Costa Gualberto says:

October 5, 2016 at 3:42 pm

+1 for snb’s work on ArrayLists!

Dick,

Did you consider:

Sub M_snb()
    With CreateObject("System.Collections.ArrayList")
        For Each it In Array("aa1", "aa2", "aa3", "aa3", "aa2", "aa6")
            .Add it
        Next

        For Each it In .toarray
           MsgBox it
        Next
    End With
end sub

Sub M_snb_001()
    With CreateObject("Scripting.Dictionary")
        For Each it In Array("aa1", "aa2", "aa3", "aa3", "aa2", "aa6")
            .Item("L_" & .Count) = it
        Next

        For Each it In .items
           MsgBox it
        Next
    End With

End Sub

Sub M_snb()

With CreateObject("System.Collections.ArrayList")

For Each it In Array("aa1", "aa2", "aa3", "aa3", "aa2", "aa6")

.Add it

For Each it In .toarray

MsgBox it

End With

end sub

Sub M_snb_001()

With CreateObject("Scripting.Dictionary")

For Each it In Array("aa1", "aa2", "aa3", "aa3", "aa2", "aa6")

.Item("L_" & .Count) = it

For Each it In .items

MsgBox it

End With

End Sub

Dick Kusleika says:

October 5, 2016 at 4:33 pm

You mean for the For Each comment? I’m talking specifically about using NewEnum in a custom class module.

Visual Basic

<pre>Private mcolLogs As Collection Public Property Get NewEnum() As IUnknown Set NewEnum = mcolLogs.[_NewEnum] End Property

1
2
3
4
5

<pre>Private mcolLogs As Collection

Public Property Get NewEnum() As IUnknown
Set NewEnum = mcolLogs.[_NewEnum]
End Property

With this, I can use

Visual Basic

<pre>For Each clsLog in clsLogs 'do something Next clsLog

1
2
3

<pre>For Each clsLog in clsLogs
'do something
Next clsLog

But as far as I know, I can’t use

Visual Basic

.[_NewEnum]

1

.[_NewEnum]

with anything but a Collection.
James Brown says:

October 6, 2016 at 2:53 am

You can get an enumerator for an ArrayList in VBA.

See http://stackoverflow.com/questions/25580867/wrap-net-arraylist-with-custom-vba-class-get-iterator
Dick Kusleika says:

October 6, 2016 at 8:38 am

Thanks James! It works!

I just realized that I can’t sort objects. That make perfect sense, but it diminishes the usefulness in this case. Here’s my test file for enumeration.

https://www.dropbox.com/s/3i7apvama6lxjzg/ArrayListEnum.xlsm?dl=0

Interesting…I haven’t come across ListArrays before.

Case Sensitivity is important to me sometimes. Which means I use Dictionaries over Collections.

I know we’re talking about VBA arrays here, but sorting in the sheet itself is really, really fast. So if your data is there to start with, sort it there, then pull it in. In fact it still seems faster to sort in the sheet even in the event that your data is in VBA to start with. i.e. dump it to a temp sheet, sort it, then pull it back to VBA. Granted this relies on you either not hitting the application.transpose limit, or alternately your unsorted data being in an appropriately dimensioned 2D array that will let you dump it to the sheet without transposing.

By way of comparison, I punched up the below code which compares how long it takes to sort both numbers and text that’s in a VBA array of dimensions1 to 1, 1 to 1000000):

Option Explicit

Private Declare Function getFrequency Lib "kernel32" _
Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" _
Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long

Function MicroTimer() As Double

  'Returns seconds.

  Dim cyTicks1 As Currency
  Static cyFrequency As Currency
  MicroTimer = 0

  ' Get frequency.
  If cyFrequency = 0 Then getFrequency cyFrequency

  ' Get ticks.
  getTickCount cyTicks1

  ' Seconds
  If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function


Sub RunTest()
Dim rUnsorted As Range
Dim vUnsorted As Variant
Set rUnsorted = Range("A1").Resize(1000000)

'Prepare test array
With rUnsorted
    .Formula = "=RAND()"
    .Value2 = .Value2
End With
vUnsorted = rUnsorted
SortArray vUnsorted, "Numerical"

With rUnsorted
    .Formula = "=RAND()&""A"""
    .Value2 = .Value2
End With
vUnsorted = rUnsorted
SortArray vUnsorted, "Text"
End Sub

Sub SortArray(vUnsorted As Variant, sDataType As String)

Dim rSortThis As Range
Dim wsTemp As Worksheet
Dim vSorted As Variant
Dim dTime As Double
Dim oArrayList  As Object
Dim i As Long


dTime = MicroTimer
'Sort in the worksheet
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .DisplayAlerts = False
End With


Set wsTemp = Worksheets.Add
With wsTemp
    Set rSortThis = .Range("A2").Resize(UBound(vUnsorted))
    rSortThis = vUnsorted
    rSortThis.Sort key1:=.Range("A1"), Order1:=xlAscending, Header:=xlNo
    vSorted = rSortThis
    .Delete
End With
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .DisplayAlerts = True
End With

dTime = Round(MicroTimer - dTime, 5)
Debug.Print "Sheet - " & sDataType & ": " & dTime

'Sort in ListArray
dTime = MicroTimer


Set oArrayList = CreateObject("System.Collections.ArrayList")
With oArrayList
    For i = 1 To UBound(vUnsorted)
        .Add vUnsorted(i, 1)
    Next i
    .Sort
    vSorted = .ToArray
End With

dTime = Round(MicroTimer - dTime, 5)
Debug.Print "ListArray - " & sDataType & ": " & dTime


End Sub

100

101

102

103

Option Explicit

Private Declare Function getFrequency Lib "kernel32" _

Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long

Private Declare Function getTickCount Lib "kernel32" _

Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long

Function MicroTimer() As Double

'Returns seconds.

Dim cyTicks1 As Currency

Static cyFrequency As Currency

MicroTimer = 0

' Get frequency.

If cyFrequency = 0 Then getFrequency cyFrequency

' Get ticks.

getTickCount cyTicks1

' Seconds

If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency

End Function

Sub RunTest()

Dim rUnsorted As Range

Dim vUnsorted As Variant

Set rUnsorted = Range("A1").Resize(1000000)

'Prepare test array

With rUnsorted

.Formula = "=RAND()"

.Value2 = .Value2

End With

vUnsorted = rUnsorted

SortArray vUnsorted, "Numerical"

With rUnsorted

.Formula = "=RAND()&""A"""

.Value2 = .Value2

End With

vUnsorted = rUnsorted

SortArray vUnsorted, "Text"

End Sub

Sub SortArray(vUnsorted As Variant, sDataType As String)

Dim rSortThis As Range

Dim wsTemp As Worksheet

Dim vSorted As Variant

Dim dTime As Double

Dim oArrayList As Object

Dim i As Long

dTime = MicroTimer

'Sort in the worksheet

With Application

.ScreenUpdating = False

.Calculation = xlCalculationManual

.EnableEvents = False

.DisplayAlerts = False

End With

Set wsTemp = Worksheets.Add

With wsTemp

Set rSortThis = .Range("A2").Resize(UBound(vUnsorted))

rSortThis = vUnsorted

rSortThis.Sort key1:=.Range("A1"), Order1:=xlAscending, Header:=xlNo

vSorted = rSortThis

.Delete

End With

With Application

.ScreenUpdating = True

.Calculation = xlCalculationAutomatic

.EnableEvents = True

.DisplayAlerts = True

End With

dTime = Round(MicroTimer - dTime, 5)

Debug.Print "Sheet - " & sDataType & ": " & dTime

'Sort in ListArray

dTime = MicroTimer

Set oArrayList = CreateObject("System.Collections.ArrayList")

With oArrayList

For i = 1 To UBound(vUnsorted)

.Add vUnsorted(i, 1)

Next i

.Sort

vSorted = .ToArray

End With

dTime = Round(MicroTimer - dTime, 5)

Debug.Print "ListArray - " & sDataType & ": " & dTime

End Sub

The result?

Sheet – Numerical: 2.54122
ListArray – Numerical: 6.95288
Sheet – Text: 7.07139
ListArray – Text: 9.52241

Dan says:

October 7, 2016 at 1:53 am

There a good walkthrogh of the Dictionary Scripting Object here:
http://www.EXCELGAARD.dk/Lib/Dictionary/
Jeff Weir says:

October 7, 2016 at 2:37 pm

Thanks for the link, Dan. I take it you’re the author of this great article? If so, I’ve got a question on it. The article says:

Notice, how you can actually use the .Item property to assign a value to a Key, instead of using the .Add method described earlier. Using the .Item property to create a Key, instead of using the .Add method, described earlier, is called ‘Silent Add’, and in fact, this way of creating Keys is significantly faster than using the .Add method, thus you should avoid using the .Add method at all, and instead stick to using the .Item property – even when creating Keys for the first time.

So a silent add is something like this:
oDic.Item(vData(i, 1)) = vData(i, 2)

…as opposed to the hard add:
oDic.Add vData(i, 1), vData(i, 2)

But I’m finding that the silent add is only about one second faster when adding one million randomly sorted keys and associated items. Will flick you my test workbook.

You can only compare methods after loading the mscor library into memory:

Sub M_snb()
  Application.DisplayAlerts = False
  With CreateObject("System.Collections.ArrayList")
  End With

   With [A1:A1000000]
      .Value = "=RAND()"
      sn = .Value
   End With

   With [B1:B1000000]
      .Value = "=""A"" & RAND()"
      sp = .Value
   End With

   t1 = MicroTimer
   With Sheets.Add
     .Cells(1).Resize(UBound(sn)) = sn
     .Cells(1).Sort .Cells(1)
     sn1 = .Cells(1).Resize(UBound(sn)).Value
     .Delete
    End With
  Debug.Print "Sheet -  numerical: " & FormatNumber(MicroTimer - t1, 5)

   t1 = MicroTimer
   With Sheets.Add
     .Cells(1).Resize(UBound(sp)) = sp
     .Cells(1).Sort .Cells(1)
     sp1 = .Cells(1).Resize(UBound(sp)).Value
     .Delete
    End With
  Debug.Print "Sheet - string: " & FormatNumber(MicroTimer - t1, 5)

  t1 = MicroTimer
  With CreateObject("System.Collections.ArrayList")
    For j = 1 To UBound(sn)
        .Add sn(j, 1)
    Next
    .Sort
    sn2 = .toarray
   End With
  Debug.Print "Arraylist numeric: " & FormatNumber(MicroTimer - t1, 5)

  t1 = MicroTimer
  With CreateObject("System.Collections.ArrayList")
    For j = 1 To UBound(sp)
        .Add sp(j, 1)
    Next
    .Sort
    sp2 = .toarray
   End With
  Debug.Print "Arraylist string: " & FormatNumber(MicroTimer - t1, 5)

End Sub

Sub M_snb()

Application.DisplayAlerts = False

With CreateObject("System.Collections.ArrayList")

End With

With [A1:A1000000]

.Value = "=RAND()"

sn = .Value

End With

With [B1:B1000000]

.Value = "=""A"" & RAND()"

sp = .Value

End With

t1 = MicroTimer

With Sheets.Add

.Cells(1).Resize(UBound(sn)) = sn

.Cells(1).Sort .Cells(1)

sn1 = .Cells(1).Resize(UBound(sn)).Value

.Delete

End With

Debug.Print "Sheet - numerical: " & FormatNumber(MicroTimer - t1, 5)

t1 = MicroTimer

With Sheets.Add

.Cells(1).Resize(UBound(sp)) = sp

.Cells(1).Sort .Cells(1)

sp1 = .Cells(1).Resize(UBound(sp)).Value

.Delete

End With

Debug.Print "Sheet - string: " & FormatNumber(MicroTimer - t1, 5)

t1 = MicroTimer

With CreateObject("System.Collections.ArrayList")

For j = 1 To UBound(sn)

.Add sn(j, 1)

.Sort

sn2 = .toarray

End With

Debug.Print "Arraylist numeric: " & FormatNumber(MicroTimer - t1, 5)

t1 = MicroTimer

With CreateObject("System.Collections.ArrayList")

For j = 1 To UBound(sp)

.Add sp(j, 1)

.Sort

sp2 = .toarray

End With

Debug.Print "Arraylist string: " & FormatNumber(MicroTimer - t1, 5)

End Sub

It gives me this result

Sheet – numerical: 3,41666

Sheet – string: 21,84833

Arraylist numeric: 10,45621

Arraylist string: 14,35369

snb: you need to turn those RAND formulas to values to perform a fair test, otherwise the “Sheet – string” time includes the overhead of recalculating 2 million RAND formulas in the original sheet when the sort is performed in the temp sheet.

If I amend your code like so:

With [A1:A1000000]
      .Value = "=RAND()"
      .Value = .Value
      sn = .Value
   End With

   With [B1:B1000000]
      .Value = "=""A"" & RAND()"
      .Value = .Value
      sp = .Value
   End With

With [A1:A1000000]

.Value = "=RAND()"

.Value = .Value

sn = .Value

End With

With [B1:B1000000]

.Value = "=""A"" & RAND()"

.Value = .Value

sp = .Value

End With

…then I get these results:
Sheet – numerical: 2.64272
Sheet – string: 7.54244
Arraylist numeric: 6.97590
Arraylist string: 9.31773

Doug Jenkins says:

October 11, 2016 at 3:48 pm

I hadn’t heard of arraylists either, but after some brief experimentation I have two questions:

You can add an array to an arraylist with a single statement, but the array is then a single item. Is there any way to sort that array?

If you add a 2D array to an arraylist is it possible to sort the array on a specified column?

Hi Dick – you can roll your own “exists” for a collection. This is one I found along the way;

Public Function IsIn(Col As Collection, Key As String) As Boolean
Dim errNum As Long, TEMP As Variant
errNum = 0
Err.Clear
On Error Resume Next
TEMP = Col.Item(Key)
errNum = CLng(Err.Number)
On Error GoTo 0
If errNum = 5 Then Exit Function      'IsIn = False
IsIn = True      'errNums 0 , 438
End Function

Public Function IsIn(Col As Collection, Key As String) As Boolean

Dim errNum As Long, TEMP As Variant

errNum = 0

Err.Clear

On Error Resume Next

TEMP = Col.Item(Key)

errNum = CLng(Err.Number)

On Error GoTo 0

If errNum = 5 Then Exit Function 'IsIn = False

IsIn = True 'errNums 0 , 438

End Function

…best, Michael

Dan says:

October 13, 2016 at 12:44 am

Doug Jenkins: http://www.EXCELGAARD.dk/Lib/Array/Functions/ArraySort/
snb says:

October 14, 2016 at 6:10 am

Doug,

AFAIK the sort method of Arraylist errors out if anything else than only strings or only numericals are part of the ArrayList.
So my answer is: no, that’s not possible in an ArrayList.

See the caveat in: http://www.snb-vba.eu/VBA_Arraylist_en.html#L_11
James Brown says:

October 14, 2016 at 7:35 am

@Doug, you could use a System.Collections.SortedList

Sorting an array in a Arraylist:
1. read the array
2. put the values of the sorting ‘column’ in an arraylist (in the example ‘column’ 3)
3. sort those values
4. add the ‘rows’ of the array into the arraylist in the resulting sorting order

Sub M_snb()
    sn = Cells(1).CurrentRegion

    With CreateObject("system.collections.Arraylist")
        For j = 1 To UBound(sn)
            .Add sn(j, 3)
        Next
        .Sort
        sp = .toarray
        .Clear

        For j = 0 To UBound(sp)
          For jj = 1 To UBound(sn)
             If sn(jj, 3) = sp(j) Then
                .Add Application.Index(sn, jj)
                sn(jj, 3) = ""
                Exit For
             End If
          Next
        Next

        For j = 0 To .Count - 1
            Cells(j + 1, 10).Resize(, UBound(sn, 2)) = .Item(j)
        Next
    End With
End Sub

Sub M_snb()

sn = Cells(1).CurrentRegion

With CreateObject("system.collections.Arraylist")

For j = 1 To UBound(sn)

.Add sn(j, 3)

.Sort

sp = .toarray

.Clear

For j = 0 To UBound(sp)

For jj = 1 To UBound(sn)

If sn(jj, 3) = sp(j) Then

.Add Application.Index(sn, jj)

sn(jj, 3) = ""

Exit For

End If

For j = 0 To .Count - 1

Cells(j + 1, 10).Resize(, UBound(sn, 2)) = .Item(j)

End With

End Sub

Doug Jenkins says:

October 15, 2016 at 12:50 am

Thanks Dan, snb and James.

I also have my own VBA sort routine, base on a comb sort (see https://newtonexcelbach.wordpress.com/2009/03/23/a-sort-function/)
and some VBA links to Python sorting routines (see https://newtonexcelbach.wordpress.com/2014/03/31/dynamic-sorting-with-excel-vba-and-python/)

When I have time I’ll compare them with the other suggestions (including Jeff’s on-sheet sort), and also update the Python to use xlwings/ExcelPython.