Click here to Skip to main content
15,885,278 members
Articles / Programming Languages / VBScript
Tip/Trick

A quick & simple VBA FIFO Queue Implementation

Rate me:
Please Sign up or sign in to vote.
4.00/5 (2 votes)
8 Jul 2010CPOL 32K   3   4
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)


Written By
Engineer
Germany Germany
This member has not yet provided a Biography. Assume it's interesting and varied, and probably something to do with programming.

Comments and Discussions

 
QuestionUse System.Collections.Queue Pin
ExcelVBAMaster1-Feb-16 3:31
ExcelVBAMaster1-Feb-16 3:31 
AnswerRe: Use System.Collections.Queue Pin
Stefan Huy31-Oct-19 4:53
Stefan Huy31-Oct-19 4:53 
GeneralMy vote of 3 Pin
Marco Bertschi18-Mar-13 1:43
protectorMarco Bertschi18-Mar-13 1:43 
GeneralNo Content Pin
#realJSOP7-Jul-10 1:36
mve#realJSOP7-Jul-10 1:36 

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

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