Linked Lists in VBA (Excel)

I use Microsoft Excel quite a bit. And recently we had a challenge at work to validate lane use signal displays using conflict matrices. Well, I had some Lisp written to generate sequences given a set of allowed 'transitions'. So I wanted to put that logic into Excel, which meant VBA. I thought it would be quick, but it took about two and a half full days of work... Part of porting over my logic was creating a linked list class named "List" in VBA. It is my first VBA class module (yay!). Here's the code in the "Node" class module:

'' Linked Lists in VBA is released under a BSD licence. Author: Jonathan F Johansen
Option Explicit
Public Car As Variant
Public Cdr As List

Public Function ToString() As String
    ToString = "[" & PlainListString() & "]"
End Function

Public Function PlainListString() As String
    If Cdr Is Nothing Then
        PlainListString = CStr(Car)
    Else
        PlainListString = CStr(Car) & ", " & Cdr.PlainListString()
    End If
End Function

I had more in the class module, but took most of the methods out of there because I wanted to treat Nothing as the empty list. Here are the functions from a separate module:

'' Linked Lists in VBA is released under a BSD licence. Author: Jonathan F Johansen
Option Explicit

'' Making Lists:

Function Cons(Item As Variant, Optional Rest As List) As List
    Set Cons = New List
    Cons.Car = Item
    Set Cons.Cdr = Rest
End Function

Function MakeList(ParamArray Items() As Variant) As List
    On Error GoTo ZeroLength ' Leaving MakeList as Nothing.
    Dim I As Long
    For I = UBound(Items) To LBound(Items) Step -1
        Set MakeList = Cons(Items(I), MakeList)
    Next I
ZeroLength:
End Function

'' Working with Lists

Function Append(aList As List, OtherList As List) As List
    If aList Is Nothing Then
        Set Append = OtherList
    ElseIf OtherList Is Nothing Then
        Set Append = aList
    ElseIf aList.Cdr Is Nothing Then
        Set Append = Cons(aList.Car, OtherList)
    Else
        Set Append = Cons(aList.Car, Append(aList.Cdr, OtherList))
    End If
End Function

Function Reverse(aList As List, Optional OntoFrontOf As List) As List
    If aList Is Nothing Then
        Set Reverse = OntoFrontOf
    Else
        Set Reverse = Reverse(aList.Cdr, Cons(aList.Car, OntoFrontOf))
    End If
End Function

Function Length(aList As List) As Long
    If aList Is Nothing Then Exit Function 'Returning 0
    Length = 1 + Length(aList.Cdr)
End Function

Function Member(Item As Variant, aList As List) As Boolean
    If aList Is Nothing Then Exit Function
    If aList.Car = Item Then
        Member = True
    ElseIf aList.Cdr Is Nothing Then
        Member = False
    Else
        Member = Member(Item, aList.Cdr)
    End If
End Function

Function Replace(OldItem As Variant, NewItem As Variant, aList As List) As List
    If aList Is Nothing Then
    ElseIf aList.Cdr Is Nothing Then
        If aList.Car = OldItem Then
            Set Replace = Cons(NewItem)
        Else
            Set Replace = aList
        End If
    Else
        If aList.Car = OldItem Then
            Set Replace = Cons(NewItem, Replace(OldItem, NewItem, aList.Cdr))
        Else
            Set Replace = Cons(aList.Car, Replace(OldItem, NewItem, aList.Cdr))
        End If
    End If
End Function

Function Remove(Item As Variant, aList As List) As List
    If aList Is Nothing Then Exit Function
    If Item = aList.Car Then
        Set Remove = Remove(Item, aList.Cdr)
    Else
        Set Remove = Cons(aList.Car, Remove(Item, aList.Cdr))
    End If
End Function

Function Count(Item As Variant, List As List) As Long
    If List Is Nothing Then Exit Function
    If List.Car = Item Then Count = 1
    Count = Count + Count(Item, List.Cdr)
End Function

Function CountMaxConsecutive(Item As Variant, List As List) As Long
    If List Is Nothing Then Exit Function
    Dim Rest As List, Count As Long
    Set Rest = List
    Do Until Rest Is Nothing
        If Rest.Car = Item Then
            Count = Count + 1
        Else
            Count = 0
        End If
        If Count > CountMaxConsecutive Then CountMaxConsecutive = Count
        Set Rest = Rest.Cdr
    Loop
End Function

Function CellTextToList(aRange As Range) As List
    Dim I As Long
    If IsEmpty(aRange) Then Exit Function
    For I = aRange.Cells.Count To 1 Step -1
        Set CellTextToList = Cons(aRange.Cells(I).Text, CellTextToList)
    Next I
End Function

Function ListToRow(aList As List, Target As Range) As Range
    Dim List As List
    Set List = aList
    Set ListToRow = Target
    Do Until List Is Nothing
        ListToRow = List.Car
        Set ListToRow = ListToRow.Offset(0, 1)
        Set List = List.Cdr
    Loop
End Function

I found it useful, but it could do with a few more utilities. One interesting thing is that looping over a list isn't to complex, as you can see in the last function above. You just declare a local List variable and then use a Do Until localList Is Nothing, and at the end of the loop body, Set localList = localList.Cdr. If you don't declare a local list, but modify the argument, you'll find that the list is chewed up in the caller's scope too...

Here are some examples of the List in action:
Option Explicit

Sub TestLinkedLists()
    MsgBox Cons("a", Cons("b")).ToString
    MsgBox Length(MakeList(1, 2, 3, 4, 5))
    MsgBox Reverse(MakeList(1, 2, 3, 4, 5)).ToString
    MsgBox MakeList(1, 2, 3, 4, 5).ToString
    MsgBox Member(4, MakeList(1, 2, 3, 4, 5))
    MsgBox Member(4, Nothing)
    MsgBox Append(MakeList(1, 2, 3, 4), MakeList(5, 6, 7)).ToString
    MsgBox Replace(4, "four", MakeList(1, 2, 3, 4, 5)).ToString
    MsgBox Remove(3, MakeList(1, 2, 3, 4, 5)).ToString
    MsgBox Count(True, MakeList(False,True,True,True,False,True))
    MsgBox CountMaxConsecutive(True, _
                     MakeList(False, True, True, True, False, True))
    MsgBox CellTextToList(Range("A2:A6")).ToString
    MsgBox "List output to B2, range returned is " _
         & ListToRow(CellTextToList(Range("A2:A6")), Range("C2")).Address _
         & " ready to go for something else..."
End Sub

If you've read the code, you might notice the liberal use of recursion, and the use of functional style. I used recursion a lot in the spreadsheet, and I think this List class helped a lot.

The code on this page is collected into an Excel spreadsheet for convenience too. You can download it from here. As noted in the code comments, the code is released under the BSD license - and I'd love to hear from you if you use it or extend it. Enjoy!