Click here to Skip to main content
Click here to Skip to main content

Tagged as

A quick & simple VBA FIFO Queue Implementation

, 8 Jul 2010
Rate this:
Please Sign up or sign in to vote.
VBA Hashtable Visual Basic Queue FIFO
Public ErrMsg As String
Public QueueIsEmpty As Boolean
 
Private Type FIFO_QueueType
    value As Variant
End Type
 
Private Function InitializeQueue(fifo() As FIFO_QueueType) As Boolean
    ErrMsg = ""
    On Error GoTo InitErr
        ReDim fifo(0)
        QueueIsEmpty = True
        InitializeQueue = True
    Exit Function
InitErr:
    InitializeQueue = False
    ErrMsg = Err.Description
End Function
 
Private Function Enqueue(fifo() As FIFO_QueueType, value As Variant) As Variant
    ErrMsg = ""
    On Error GoTo EnqueueErr
        If IsEmpty(value) Or IsNull(value) Or value = "" Then Err.Raise 9999, , "No value to handle"
        Dim idx As Long
        
        Dim fifoVal As FIFO_QueueType
        fifoVal.value = value
        
        idx = UBound(fifo) + 1
        ReDim Preserve fifo(idx)
        fifo(idx) = fifoVal
        QueueIsEmpty = False
        Enqueue = True
    Exit Function
EnqueueErr:
    Enqueue = Err.Description
    ErrMsg = Err.Description
End Function
 
Private Function Dequeue(fifo() As FIFO_QueueType) As Variant
    ErrMsg = ""
    On Error GoTo PopErr
        If UBound(fifo) = 0 Then
            QueueIsEmpty = True
            Err.Raise 9998, , "Queue is empty"
        End If
        
        Dequeue = fifo(1).value
        
        Dim fifoTmp() As FIFO_QueueType
        ReDim fifoTmp(UBound(fifo) - 1)
        
        If UBound(fifo) > 1 Then
            For i = 1 To UBound(fifo) - 1
                fifoTmp(i).value = fifo(i + 1).value
            Next i
            fifo = fifoTmp
        Else
            ReDim fifo(0)
            QueueIsEmpty = True
        End If
    Exit Function
PopErr:
    Dequeue = Err.Description
    ErrMsg = Err.Description
End Function
 
Private Function GetQueueCount(fifo() As FIFO_QueueType) As Long
    If QueueIsEmpty Then GetQueueCount = 0 Else GetQueueCount = UBound(fifo)
End Function
 
Public Sub Test_Queue()
    'Create a variable for the queue:
    Dim queue() As FIFO_QueueType
    
    'Initializing the queue: Initializequeue(queue)
    Debug.Print "Initialize: " & InitializeQueue(queue)
    Debug.Print ""
    Debug.Print "*** Push some Test Values:"
    
    'Pushing some values: Push(queue, value)
    Debug.Print "EnQueue Test1: " & Enqueue(queue, "Test 1")
    Debug.Print "EnQueue Test2: " & Enqueue(queue, "Test 2")
    Debug.Print "EnQueue Test3: " & Enqueue(queue, "Test 3")
    Debug.Print "EnQueue Test4: " & Enqueue(queue, "Test 4")
    Debug.Print "EnQueue Test5: " & Enqueue(queue, "Test 5")
    Debug.Print "EnQueue Null : " & Enqueue(queue, Null)
 
    Debug.Print ""
    Debug.Print "*** DeQueue all queued values:"
    
    'Removing/Getting the values Pop(queue)
    Do While Not QueueIsEmpty
        Debug.Print "DeQueue First In: " & GetQueueCount(queue) & " - " & Dequeue(queue)
    Loop
    Debug.Print "DeQueue First In: " & GetQueueCount(queue) & " - " & Dequeue(queue)
End Sub

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Share

About the Author

Stefan Huy
Engineer
Germany Germany
No Biography provided
Follow on   Twitter   LinkedIn

Comments and Discussions

 
GeneralMy vote of 3 PinmemberMarco Bertschi18-Mar-13 1:43 
GeneralNo Content PinmemberJohn Simmons / outlaw programmer7-Jul-10 1:36 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.

| Advertise | Privacy | Mobile
Web03 | 2.8.140814.1 | Last Updated 8 Jul 2010
Article Copyright 2010 by Stefan Huy
Everything else Copyright © CodeProject, 1999-2014
Terms of Service
Layout: fixed | fluid