Option Explicit
' 
' Queue object implemented as a doubly linked list
'
Const ERRQueueEmpty = 10000

Class QueueLink
    Public Item
    Public Nxt
    Public Prv
End Class

Class Queue

    Public Property Get Length
        Length = Count
    End Property
    
    Public Sub EnQueue(Item)
        Dim Link
        Set Link = New QueueLink
        If IsObject(Item) Then
            Set Link.Item = Item
        Else
Link.Item = Item
        End If
        Set Link.Prv = Nothing
        Set Link.Nxt = Tail
        If Not Tail Is Nothing Then Set Tail.Prv = Link
        Set Tail = Link
        If Head Is Nothing Then Set Head = Link
        Count = Count + 1
    End Sub

    Public Function DeQueue
        Dim Prv
        If Count = 0 Then Err.Raise ERRQueueEmpty, "Queue", "Queue is empty"
        If IsObject(Head.Item) Then
            Set DeQueue = Head.Item
        Else
            DeQueue = Head.Item
        End If

        Head.Item = Empty
        Set Prv = Head.Prv
        Set Head.Prv = Nothing
        Set Head = Prv
        If Head Is Nothing Then 
            Set Tail = Nothing
        Else
            Set Head.Nxt = Nothing
        End If
        Count = Count — 1
    End Function    

    Private Count
    Private Head
    Private Tail

    Private Sub Class_Initialize
        Count = 0
        Set Head = Nothing
        Set Tail = Nothing
    End Sub

End Class

Sub Main

    Dim Q
    Set Q = New Queue
    Q.EnQueue 1
    Q.EnQueue 2
    MsgBox Q.DeQueue ' 1
    Q.EnQueue 3
    MsgBox Q.DeQueue ' 2
    MsgBox Q.DeQueue ' 3

End Sub

Figure 2   Shuffling a Card Deck

Const errDeckEmpty = 20000

Class Card
    Public Suit
    Public Rank
    Public Property Get Name
        Name = "The " & Rank & " of " & Suit
    End Property
End Class

Class Deck

    Private CardsQueue
    
    Private Sub Class_Initialize
        
        ' Create a sorted array of cards, shuffle the array
        ' and put the results into a queue.

Dim S, R, I, Suits, Ranks, C, Cards(51)

        Set CardsQueue = New Queue

        Suits = Array("Spades", "Hearts", "Diamonds", "Clubs")
        Ranks = Array("Ace", "Deuce", "Trey", "Four", "Five", "Six", "Seven", _
            "Eight", "Nine", "Ten", "Jack", "Queen", "King")
        
        For S = LBound(Suits) To UBound(Suits)
            For R = LBound(Ranks) To UBound(Ranks)
                Set C = New Card
                C.Suit = Suits(S)
                C.Rank = Ranks(R)
                Set Cards(S * 13 + R) = C
            Next
        Next

        Shuffle Cards

        For I = 0 To 51
            CardsQueue.Enqueue Cards(I)
        Next

    End Sub

    Private Sub Shuffle(Cards)
        ' Durstenfeld's Permutation Algorithm
        Dim J, K, Temp
        Randomize
        For J = UBound(Cards) To 1 Step —1
            K = Int((J + 1) * Rnd) ' random number 0 — J
            Set Temp = Cards(J)
            Set Cards(J) = Cards(K)
            Set Cards(K) = Temp
        Next
    End Sub

    Public Function Deal
        If CardsQueue.Length = 0 Then
            Err.Raise 20000, "Deck", "Deck empty"
        End If
        Set Deal = CardsQueue.Dequeue
    End Function
                
End Class

Sub Main
    Dim MyDeck, I
    Set MyDeck = New Deck
    For I = 1 to 5
        MsgBox MyDeck.Deal.Name
    Next
End Sub