A Very Basic Singely Linked List for VBA

• Download source code - 35.9 KB

Introduction

Linked Lists are used in many different ways to dynamically store and retrieve data in a logical order as opposed to storing the data based upon the physical order. Linked Lists can be very useful in certain situations and yet very frustrating to build if the base language does not directly support certain data types. Here is a quick version of a node-based Linked List written in VBA and Excel 2016 (for those of us confined to a scripting language).

Background

This is the "how" as opposed to the "why" of programming. "Why" should be reserved for chat-rooms and such. VBA does not directly support pointers while also passing all data from and to functions, subs, properties, etc. with pointers unless specified otherwise with the keyword ByVal. Using ByRef or omitting the keyword in the passing of variables is passing by pointers. Yet, VBA does not give easy access to said pointers. There are ways (LongPTR and memcopy) to see the reference pointer as a long and change the variable or pointer, but that is a more advanced answer to the problem of Linked Lists and VBA that I did not want to spend too much time on. This answer is basic and uses a node-type class with simple dialog to follow.

Using the Code

There are three classes and one testing module included with this code. Remember to name each class exactly as it appears or it will not compile. Please download the example to see how the testing module fully uses all elements of the LinkedList_CLS.

How to declare the classes in the Test_Module:

'''''''''''''''''''' Test_Module ''''''''''''''''''''''''''''''''''''''''
' by Samuel J Bowlin                                                    '
' 3/10/2019                                                             '
' Version 1.0.0                                                         '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''''' Testing module for node and linked list '''''''''''''
Option Explicit

' testing sub
Sub Test()
    ' turn features off
    Dim oHelper As Helper: Set oHelper = New Helper
    ' basic error catching (nothing fancy here)
    On Error GoTo Err
    ' declare new linked list
    Dim oLinkedList As LinkedList_CLS: Set oLinkedList = New LinkedList_CLS
    ' determine if running or not
    Dim running As Boolean: running = True
    ' set workbook and worksheet
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Sheets("OutPut")
    ' local variables
    Dim intIn As Integer: Dim answerIn As Variant

This is a simple Helper class that speeds things up:

'''''''''''''''''''' Helper '''''''''''''''''''''''''''' ''''''''''''''''
' by Samuel J Bowlin                                                    '
' 3/10/2019                                                             '
' Version 1.0.0                                                         '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''''' Class turn off and on features ''''''''''''''''''''''
Option Explicit

' turn off features when class is created
Private Sub Class_Initialize()
    Application.Calculation = xlCalculationManual
    'Application.ScreenUpdating = False
    Application.EnableEvents = False
End Sub

' turn on features when class is destroyed
Private Sub Class_Terminate()
    Application.Calculation = xlCalculationAutomatic
    'Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Here is the Node_CLS class which contains the data and the pointer to the next node:

'''''''''''''''''''' Node_CLS '''''''''''''''''''''''''''''''''''''''''''
' by Samuel J Bowlin                                                    '
' 3/10/2019                                                             '
' Version 1.0.0                                                         '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''''' Class to hold node data and pointers ''''''''''''''''
Option Explicit

''''''''''''''''''' Public access variables '''''''''''''''''''''''''''''
Public data As Integer
Public nextNode As Node_CLS

Here is the LinkedList_CLS broken down by each sub, function, or property:

'''''''''''''''''''' LinkedList_CLS '''''''''''''''''''''''''''''''''''''
' by Samuel J Bowlin                                                    '
' 3/10/2019                                                             '
' Version 1.0.0                                                         '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''''' Class to manipulate Node_CLS ''''''''''''''''''''''''
Option Explicit

'''''''''''''''''''' Private variables to use in this class '''''''''''''
Private head As Node_CLS

'''''''''''''''''''' Public properties ''''''''''''''''''''''''''''''''''

' add data to front of the list non-recursively
Public Property Let push(pushData As Integer)
    Dim pushNode As Node_CLS: Set pushNode = New Node_CLS
    pushNode.data = pushData
    Set pushNode.nextNode = head
    Set head = pushNode
End Property

' add data to back of list non-recursively
Public Property Let append(appendData As Integer)
    Dim appendNode As Node_CLS: Set appendNode = New Node_CLS
    appendNode.data = appendData
    If head Is Nothing Then
        Set head = appendNode
        Exit Property
    Else
        Dim last As Node_CLS: Set last = head
        Do Until last.nextNode Is Nothing
            Set last = last.nextNode
        Loop
        Set last.nextNode = appendNode
     End If
End Property

' get length of list as integer non-recursively
Public Property Get getLength() As Integer
    getLength = get_Length(head)
End Property

' remove data from list non-recursively
Public Property Let remove(removeData As Integer)
    Dim removeNode As Node_CLS: Set removeNode = head
    Dim prevNode As Node_CLS
    Do Until removeNode Is Nothing
        If removeNode.data = removeData Then
            If removeNode Is head Then
                Set head = removeNode.nextNode
            Else
                Set prevNode.nextNode = removeNode.nextNode
            End If
            Exit Property
        End If
        Set prevNode = removeNode
        Set removeNode = removeNode.nextNode
    Loop
End Property

' check if data exists in list non-recursively
Public Property Get exists(dataExists As Integer) As Boolean
    Dim existsNode As Node_CLS: Set existsNode = head
    Do Until existsNode Is Nothing
        If existsNode.data = dataExists Then
            exists = True
            Exit Property
        End If
        Set existsNode = existsNode.nextNode
    Loop
End Property

' get position of data in list (0 through ?) non-recursively
Public Property Get pos(dataPos As Integer) As Integer
    If Not exists(dataPos) Then: pos = -1: Exit Property
    Dim posNode As Node_CLS: Set posNode = head
    Do Until posNode Is Nothing
        If posNode.data = dataPos Then
            Exit Property
        Else
            Set posNode = posNode.nextNode
            pos = pos + 1
        End If
    Loop
End Property

' see if list is empty
Public Property Get isEmpty() As Boolean
    If head Is Nothing Then
        isEmpty = True
    End If
End Property

' get node data at nth position from front non-recursively
Public Property Get getNth(nth As Integer) As Integer
    Dim nthNode As Node_CLS: Set nthNode = head
    Dim nthCount As Integer
    Do Until nthNode Is Nothing
        If nthCount + 1 = nth Then
            getNth = nthNode.data: Exit Property
        Else
            nthCount = nthCount + 1: Set nthNode = nthNode.nextNode
        End If
    Loop
    getNth = -1
End Property

' get nth node data from last non-recursively
Public Property Get getNthFromLast(nthFromLast As Integer) As Integer
    Dim nthCount As Integer: nthCount = get_Length(head)
    Dim nthNode As Node_CLS: Set nthNode = head
    Dim i As Integer
    If nthCount >= nthFromLast Then
        For i = 0 To nthCount - nthFromLast - 1
            Set nthNode = nthNode.nextNode
        Next i
        getNthFromLast = nthNode.data: Exit Property
    End If
    getNthFromLast = -1
End Property

' get middle data of list non-recursively
Public Property Get middle() As Integer
    If Not isEmpty() And Not head.nextNode Is Nothing Then
        Dim mid As Integer: mid = (get_Length(head) / 2)
        Dim midNode As Node_CLS: Set midNode = head
        Do Until mid - 1 = 0
            Set midNode = midNode.nextNode
            mid = mid - 1
        Loop
        middle = midNode.data: Exit Property
    End If
    middle = -1
End Property
' get number of times a var appears in list
Public Property Get countTotal(dataCount As Integer) As Integer
    Dim countNode As Node_CLS: Set countNode = head
    Do Until countNode Is Nothing
        If dataCount = countNode.data Then
            countTotal = countTotal + 1
        End If
        Set countNode = countNode.nextNode
    Loop
End Property
' print out node data non-recursively
Public Property Let printNodes(MyWS As Worksheet)
    MyWS.Range("F:F").ClearContents
    Dim rowCounter As Integer: rowCounter = 1
    Dim nodeToPrint As Node_CLS: Set nodeToPrint = head
    Do Until nodeToPrint Is Nothing
        MyWS.Cells(rowCounter, 6).Value = nodeToPrint.data
        rowCounter = rowCounter + 1
        Set nodeToPrint = nodeToPrint.nextNode
    Loop
End Property

'''''''''''''''''''' Public subs ''''''''''''''''''''''''''''''''''''''''

' merge sort the list recursively
Public Sub mergeSort()
    If isEmpty Then: Exit Sub
    If head.nextNode Is Nothing Then: Exit Sub
    Set head = merge(head)
End Sub

' delete the list non-recursively
Public Sub deleteList()
    Do Until head Is Nothing
        Set head = head.nextNode
    Loop
    Set head = Nothing
End Sub

'''''''''''''''''''' Private properties '''''''''''''''''''''''''''''''''

' merge sort the list (Property Get mergeSort)
Private Property Get merge(mergeNode As Node_CLS) As Node_CLS
    Dim oldHead As Node_CLS: Set oldHead = mergeNode
    Dim mid As Integer: mid = (get_Length(mergeNode) / 2) - 1
    If mergeNode.nextNode Is Nothing Then: Set merge = mergeNode: Exit Property
    Do Until mid = 0
        Set oldHead = oldHead.nextNode
        mid = mid - 1
    Loop
    Dim newHead As Node_CLS: Set newHead = oldHead.nextNode
    Set oldHead.nextNode = Nothing
    Set oldHead = mergeNode
    Dim front As Node_CLS: Set front = merge(oldHead)
    Dim back As Node_CLS: Set back = merge(newHead)
    Set merge = mergeList(front, back)
End Property

' merged two list for merge sort (Property Get merge)
Private Property Get mergeList(a As Node_CLS, b As Node_CLS) As Node_CLS
    Dim resultNode As Node_CLS
    If a Is Nothing Then: Set mergeList = b: Exit Property
    If b Is Nothing Then: Set mergeList = a: Exit Property
    If a.data > b.data Then
        Set resultNode = b
        Set resultNode.nextNode = mergeList(a, b.nextNode)
    Else
        Set resultNode = a
        Set resultNode.nextNode = mergeList(a.nextNode, b)
    End If
    Set mergeList = resultNode
End Property

' get length of given list (Property Get getLength)
Private Property Get get_Length(getLengthNode As Node_CLS) As Integer
    Dim lengthNode As Node_CLS: Set lengthNode = getLengthNode
    Do Until lengthNode Is Nothing
        Set lengthNode = lengthNode.nextNode
        get_Length = get_Length + 1
    Loop
End Property

'''''''''''''''''''' Private subs '''''''''''''''''''''''''''''''''''''''

' initialize the class
Private Sub Class_Initialize()

End Sub

' destroy the class
Private Sub Class_Terminate()
    Set head = Nothing
End Sub

Points of Interest

Destroying large lists (say 10,000 elements on up) has proven time consuming and sometimes problematic. VBA is just not that easy to manage the stack with. However, smaller lists seems to work fine with no errors that I have found.

History

• 3/10/2019: 1^st draft - Version 1.0.0 stable on Excel 2016