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!
