'-------------------------------------------------' LINKED LIST class module'' This class implements a linked list structure, where you can store' values (appending them after the last element or inserting them at' given indexes), remove them, and visit them using recordset-like' methods such as MoveFirst, MoveNext, and Move(n)'' NOTE: make Item the default member for this class'       you can do so from inside the Tools | Procedure Attributes dialog box'' Usage:'   Dim ll As New LinkedList'   ' optionally size the inner array'   ll.SetSize 10000'   ' add new elements (can optionally take Before or After element)'   ' returns the index where the element has been stored'   newIndex = ll.Add newValue''   ' loop over all elements'   ll.MoveFirst'   Do Until ll.EOL'       ' display or process the current element'       Print ll.Item'       ' move to next element'   Loop''   See remarks for the FIND method for details about performing searches'   on the elements in the linked list''-------------------------------------------------Option Explicit' these are used by the Find methodPublic Enum FindConditionConstants    fccEqual    fccNotEqual    fccLess    fccLessEqual    fccGreater    fccGreaterEqual    fccInStrEnd Enum' initial size of the listConst DEFAULT_INITIALSIZE = 100' how many items are allocated each timeConst DEFAULT_CHUNKSIZE = 100Private Type ListType    Value As Variant    prevNdx As Long    ' -1 if the element is free    nextNdx As LongEnd Type' the actual listDim List() As ListType' number of items in the listDim m_Count As Long' index of first/last item in the listPrivate FirstNdx As LongPrivate LastNdx As Long' index of first free item in the listPrivate FreeNdx As Long' chucnk sizePrivate m_ChunkSize As Long' index to the current elementPrivate m_CurrIndex As Long' current EOL status of the list' (is valid only when m_CurrIndex = 0)Private m_EOL As Boolean     ' if False, then BOL is true' the index of the current elementProperty Get CurrIndex() As Long    CurrIndex = m_CurrIndexEnd PropertyProperty Let CurrIndex(ByVal newValue As Long)    m_CurrIndex = newValueEnd Property' move to the first elementSub MoveFirst()    m_CurrIndex = FirstNdxEnd Sub' move to the last elementSub MoveLast()    m_CurrIndex = LastNdxEnd Sub' move the the previous elementSub MovePrevious()    ' this code works also when m_CurrIndex = 0    m_CurrIndex = List(m_CurrIndex).prevNdx    ' in case we move too much    m_EOL = FalseEnd Sub' move to the next elementSub MoveNext()    ' this code works also when m_CurrIndex = 0    m_CurrIndex = List(m_CurrIndex).nextNdx    ' in case we move too much    m_EOL = TrueEnd Sub' move to the Nth elementSub Move(ByVal Index As Long)    CheckIndex Index    ' if there were no error, then update the current Index    m_CurrIndex = IndexEnd Sub' Return true if we are at the beginning of listProperty Get BOL() As Boolean    BOL = (m_Count = 0) Or (m_CurrIndex = 0 And m_EOL = False)End Property' Return true if we are at the end of listProperty Get EOL() As Boolean    EOL = (m_Count = 0) Or (m_CurrIndex = 0 And m_EOL = True)End Property' An item of the list (read-write)' if the argument is omitted it retrieves the current itemProperty Get Item(Optional ByVal Index As Long) As VariantAttribute Item.VB_UserMemId = 0    If Index = 0 Then Index = m_CurrIndex    ' check that the index point to a valid, non-free element    CheckIndex Index    ' two cases: the value is/isn't an object    If IsObject(List(Index).Value) Then        Set Item = List(Index).Value    Else        Item = List(Index).Value    End IfEnd PropertyProperty Let Item(Optional ByVal Index As Long, newValue As Variant)    If Index = 0 Then Index = m_CurrIndex    ' check that this is a valid, non-free item    CheckIndex Index    ' modify the value in the list    List(Index).Value = newValueEnd PropertyProperty Set Item(Optional ByVal Index As Long, newValue As Object)    If Index = 0 Then Index = m_CurrIndex    ' check that this is a valid, non-free item    CheckIndex Index    ' modify the value in the list    Set List(Index).Value = newValueEnd Property' return True if the list is emptyProperty Get IsEmpty() As Boolean    IsEmpty = (m_Count = 0)End Property' the number of elements in the listProperty Get Count() As Long    Count = m_CountEnd Property' insert a new item before/after a given element' if both arguments are omitted it is appended to the end of the list' a zero or negative value for Before means "at the beginning of the list"' and works also when the list is empty'' returns the index of the new valueFunction Add(Value As Variant, Optional ByVal Before As Long, _    Optional ByVal After As Long) As Long    Dim ndx As Long    Dim nextFreeNdx As Long        ' enlarge the list if necessary    If FreeNdx = 0 Then ExpandList m_ChunkSize    ' use the first free slot    ndx = FreeNdx    nextFreeNdx = List(ndx).nextNdx        ' a special value for Before that means "at the beginning of the list"    If Before < 0 Then Before = FirstNdx        If Before > 0 Then        ' check that this is a valid, non-free item        CheckIndex Before        ' "Before" item becomes this item's next element        List(ndx).nextNdx = Before        ' "Before"'s previous element becomes this item's previous element        List(ndx).prevNdx = List(Before).prevNdx        ' "Before's" previous element should point to this item        List(Before).prevNdx = ndx                If Before = FirstNdx Then            ' "Before" was the first item in the list            FirstNdx = ndx        Else            ' else, another item's next element points to this item            List(List(ndx).prevNdx).nextNdx = ndx        End If        ElseIf After > 0 Then        ' check that this is a valid, non-free item        CheckIndex After        ' "After" item becomes this item's previous element        List(ndx).prevNdx = After        ' "After" item's next element becomes this item's next element        List(ndx).nextNdx = List(After).nextNdx        ' "After"'s next element should point to this item        List(After).nextNdx = ndx                If After = LastNdx Then            ' "After" was the last item in the list            LastNdx = ndx        Else            ' else, another item's previous element points to this item            List(List(ndx).nextNdx).prevNdx = ndx        End If            Else        ' append at the end of the list        If LastNdx Then            ' this item becomes the "next" item of the            ' item that was at the end of the list            List(LastNdx).nextNdx = ndx            List(ndx).prevNdx = LastNdx        Else            ' this is the first and only item in the list            FirstNdx = ndx            ' signal that this item isn't free any longer            List(ndx).prevNdx = 0        End If        ' in all cases this becomes the last item in the list        LastNdx = ndx        List(ndx).nextNdx = 0    End If        ' actually store the new value    If IsObject(Value) Then        Set List(ndx).Value = Value    Else        List(ndx).Value = Value    End If    ' remember we have a new item    m_Count = m_Count + 1    ' FreeNdx must point to the first free slot    FreeNdx = nextFreeNdx        ' return the index of the element just added    Add = ndx    End Function' remove an item given its index' if the index is omitted it removes the current item'' if the item is also the current item, then its subsequent' element becomes the current item (if it was the last element' then the EOL condition becomes True)Sub Remove(Optional ByVal Index As Long)    If Index = 0 Then Index = m_CurrIndex    ' check that this is a valid, non-free item    CheckIndex Index        If Index = FirstNdx Then        ' the item being removed is the first of the list        FirstNdx = List(Index).nextNdx        List(FirstNdx).prevNdx = 0    ElseIf Index = LastNdx Then        ' the item being removed is the last of the list        ' but the list contains at least another item        LastNdx = List(Index).prevNdx        List(LastNdx).nextNdx = 0    Else        ' the item is in the middle of the list        List(List(Index).prevNdx).nextNdx = List(Index).nextNdx        List(List(Index).nextNdx).prevNdx = List(Index).prevNdx    End If    ' clear this item's value    List(Index).Value = Empty    ' remember we have one element less    m_Count = m_Count - 1        ' if this was the current item, update m_CurrIndex    If Index = m_CurrIndex Then        m_CurrIndex = List(Index).nextNdx        ' if it was the last element of the list        If m_CurrIndex = 0 Then m_EOL = True    End If    ' put it at the beginning of the free list    List(Index).nextNdx = FreeNdx    ' mark it as free    List(Index).prevNdx = -1    FreeNdx = IndexEnd Sub' remove all items' this method also resets any SetSize settingSub RemoveAll()    ' it simply restarts from the very beginning    Class_InitializeEnd Sub' search a value in the list'' STARTINDEX is the index of the element from where to' start the search - use ZERO or omitted to start from' the current element, use -1 to start from first/last element' if DESCENDING is True then it does a reverse search'' returns the index of the found element, or zero if not found' the element also becomes the current elementFunction Find(Value As Variant, Optional Condition As FindConditionConstants = _    fccEqual, Optional ByVal StartIndex As Long, Optional ByVal Descending As _    Boolean) As Long    Dim isObj As Boolean        ' provide reasonable defaults    If StartIndex = 0 Then        StartIndex = m_CurrIndex    ElseIf StartIndex < 0 Then        If Not Descending Then            StartIndex = FirstNdx        Else            StartIndex = LastNdx        End If    Else        ' check that this index is valid        CheckIndex StartIndex        ' start from the next or previous element        If Not Descending Then            StartIndex = List(StartIndex).nextNdx        Else            StartIndex = List(StartIndex).prevNdx        End If    End If        ' evaluate this once and for all    isObj = IsObject(Value)        ' two loops, depending on value being an object or not    Do While StartIndex        If isObj Then            ' do the comparison only if the element is also an object            If IsObject(List(StartIndex).Value) Then                If Value Is List(StartIndex).Value Then                    ' exit if we're looking for equality                    If Condition <> fccNotEqual Then Exit Do                Else                    ' exit if we're looking for inequality                    If Condition = fccNotEqual Then Exit Do                End If            End If        Else            ' do the comparison only if the element isn't an object            If Not IsObject(List(StartIndex).Value) Then                Select Case Condition                    Case fccNotEqual                        If List(StartIndex).Value <> Value Then Exit Do                    Case fccLess                        If List(StartIndex).Value < Value Then Exit Do                    Case fccLessEqual                        If List(StartIndex).Value <= Value Then Exit Do                    Case fccGreater                        If List(StartIndex).Value > Value Then Exit Do                    Case fccGreaterEqual                        If List(StartIndex).Value >= Value Then Exit Do                    Case fccInStr                        If InStr(List(StartIndex).Value, Value) Then Exit Do                    Case Else                        ' equality is the default test                        If List(StartIndex).Value = Value Then Exit Do                End Select            End If        End If        ' skip to the next or previous item        If Not Descending Then            StartIndex = List(StartIndex).nextNdx        Else            StartIndex = List(StartIndex).prevNdx        End If    Loop            ' make the item the current item and return its index    m_CurrIndex = StartIndex    Find = StartIndex        End Function' modify the list size and growth factor' you can expand but not shrink a linked listSub SetSize(ByVal numEls As Long, Optional ByVal ChunkSize As Long)    ' raise an error if invalid arguments    If numEls <= 0 Or ChunkSize < 0 Then Err.Raise 5        If numEls > UBound(List) Then        ' expand the list        ExpandList numEls - UBound(List)    End If    ' remember new ChunkSize    m_ChunkSize = ChunkSizeEnd Sub'--------------------------------------------' Private procedures'--------------------------------------------Private Sub Class_Initialize()    ' initialize the linked list of free slots    ReDim List(0) As ListType    ExpandList DEFAULT_INITIALSIZE    m_ChunkSize = DEFAULT_CHUNKSIZEEnd Sub' check that there is at least one free slotPrivate Sub ExpandList(ByVal numEls As Long)    Dim ndx As Long, newFreeNdx As Long        ' this will be the first free slot    newFreeNdx = UBound(List) + 1    ' expand the list    ReDim Preserve List(UBound(List) + numEls) As ListType    ' initialize the links for free items    ' (note that the nextNdx value for the last element isn't correct    For ndx = newFreeNdx To UBound(List)        List(ndx).nextNdx = ndx + 1        List(ndx).prevNdx = -1    Next    ' append the existing chain of free slots    ' (fixes the invalid value stored previously)    List(UBound(List)).nextNdx = FreeNdx    ' this is the new start of the free list    FreeNdx = newFreeNdxEnd Sub' check whether an index is validSub CheckIndex(ByVal Index As Long)    If Index <= 0 Or Index > UBound(List) Then Err.Raise 5    If List(Index).prevNdx < 0 Then Err.Raise 5End Sub