VBA - How to make a queue in an array? (FIFO) first in first out

Question

I am trying to make a queue which is able to show the first in first out concept. I want to have an array which works as a waiting list. The patients who come later will be discharged later. There is a limitation of 24 patients in the room the rest will go to a waiting list. whenever the room is empty the first patients from the waiting room (the earliest) goes to the room. Here is the code that I have come up with so far. Any help is greatly appreciated.

    Dim arrayU() As Variant
    Dim arrayX() As Variant
    Dim arrayW() As Variant
    Dim LrowU As Integer
    Dim LrowX As Integer
    Dim LrowW As Integer
    'Dim i As Integer
    Dim j As Integer
    Dim bed_in_use As Integer

    LrowU = Columns(21).Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    LrowX = Columns(24).Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    LrowW = Columns(23).Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    ReDim arrayU(1 To LrowU)
    ReDim arrayX(1 To LrowX)
    ReDim arrayW(1 To LrowW)

    For i = 3 To LrowU
        arrayU(i) = Cells(i, 21)
    Next i

    i = 3

    For i = 3 To LrowX
        arrayX(i) = Cells(i, 24)
    Next i

    i = 3
    j = 3

    For r = 3 To LrowW
         arrayW(r) = Cells(r, 23)
    Next r
    r = 3
    i = 3
    j = 3


    For i = 3 To LrowX ' the number of bed in use is less than 24 (HH)
        If bed_in_use >= 24 Then GoTo Line1
    For j = 3 To LrowU
        If bed_in_use >= 24 Then GoTo Line1
            If arrayX(i) = arrayU(j) Then
            If Wait_L > 0 Then
            Wait_L = Wait_L - (24 - bed_in_use)
            Else
            bed_in_use = bed_in_use + 1

            End If
            End If

        Next j

Line1:

    For r = 3 To LrowW
          If bed_in_use < 24 Then Exit For
          If arrayX(i) = arrayW(r) Then
          bed_in_use = bed_in_use - 1
          Wait_L = Wait_L + 1


       End If
    Next r

       Cells(i, "Y").Value = bed_in_use
    Cells(i, "Z").Value = Wait_L
Next i

Answer 1

Easiest way to do this would be to implement a simple class that wraps a Collection. You could wrap an array, but you'd end up either having to copy it every time you dequeued an item or letting dequeued items sit in memory.

In a Class module (I named mine "Queue"):

Option Explicit

Private items As New Collection

Public Property Get Count()
    Count = items.Count
End Property

Public Function Enqueue(Item As Variant)
    items.Add Item
End Function

Public Function Dequeue() As Variant
    If Count > 0 Then
        Dequeue = items(1)
        items.Remove 1
    End If
End Function

Public Function Peek() As Variant
    If Count > 0 Then
        Peek = items(1)
    End If
End Function

Public Sub Clear()
    Set items = New Collection
End Sub

Sample usage:

Private Sub Example()
    Dim q As New Queue

    q.Enqueue "foo"
    q.Enqueue "bar"
    q.Enqueue "baz"

    Debug.Print q.Peek          '"foo" should be first in queue
    Debug.Print q.Dequeue       'returns "foo".
    Debug.Print q.Peek          'now "bar" is first in queue.
    Debug.Print q.Count         '"foo" was removed, only 2 items left.
End Sub

Answer 2

Would you not follow Comintern's "Class" approach (but I'd go with it!) you can stick to an "array" approach like follows

place the following code in any module (you could place it at the bottom of you code module, but you'd be better placing it in a new module to call, maybe, "QueueArray"...)

Sub Clear(myArray As Variant)
Erase myArray
End Sub


Function Count(myArray As Variant) As Long
If isArrayEmpty(myArray) Then
    Count = 0
Else
    Count = UBound(myArray) - LBound(myArray) + 1
End If
End Function


Function Peek(myArray As Variant) As Variant
If isArrayEmpty(myArray) Then
    MsgBox "array is empty! -> nothing to peek"
Else
    Peek = myArray(LBound(myArray))
End If
End Function


Function Dequeue(myArray As Variant) As Variant
If isArrayEmpty(myArray) Then
    MsgBox "array is empty! -> nothing to dequeue"
Else
    Dequeue = myArray(LBound(myArray))
    PackArray myArray
End If
End Function


Sub Enqueue(myArray As Variant, arrayEl As Variant)
Dim i As Long

EnlargeArray myArray
myArray(UBound(myArray)) = arrayEl

End Sub


Sub PackArray(myArray As Variant)
Dim i As Long

If LBound(myArray) < UBound(myArray) Then
    For i = LBound(myArray) + 1 To UBound(myArray)
        myArray(i - 1) = myArray(i)
    Next i
    ReDim Preserve myArray(LBound(myArray) To UBound(myArray) - 1)
Else
    Clear myArray
End If

End Sub


Sub EnlargeArray(myArray As Variant)
Dim i As Long

If isArrayEmpty(myArray) Then
    ReDim myArray(0 To 0)
Else
    ReDim Preserve myArray(LBound(myArray) To UBound(myArray) + 1)
End If
End Sub


Public Function isArrayEmpty(parArray As Variant) As Boolean
'http://stackoverflow.com/questions/10559804/vba-checking-for-empty-array
'assylias's solution

'Returns true if:
'  - parArray is not an array
'  - parArray is a dynamic array that has not been initialised (ReDim)
'  - parArray is a dynamic array has been erased (Erase)

  If IsArray(parArray) = False Then isArrayEmpty = True

  On Error Resume Next

  If UBound(parArray) < LBound(parArray) Then
      isArrayEmpty = True
      Exit Function
  Else
      isArrayEmpty = False
  End If

End Function

then in your main sub you could go like this:

Option Explicit

Sub main()

    Dim arrayU As Variant
    Dim arrayX As Variant
    Dim arrayW As Variant

    Dim myVar As Variant

    Dim j As Integer, i As Integer, R As Integer
    Dim bed_in_use As Integer, Wait_L As Integer

    Dim arrayXi As Variant
    Const max_bed_in_use As Integer = 24 'best to declare a "magic" value as a constant and use "max_bed_in_use" in lieu of "24" in the rest of the code

    'fill "queue" arrays
    With ActiveSheet
        arrayU = Application.Transpose(.Range(.cells(3, "U"), .cells(.Rows.Count, "U").End(xlUp))) 'fill arrayU
        arrayX = Application.Transpose(.Range(.cells(3, "X"), .cells(.Rows.Count, "X").End(xlUp))) 'fill arrayX
        arrayW = Application.Transpose(.Range(.cells(3, "W"), .cells(.Rows.Count, "W").End(xlUp))) 'fill arrayW
    End With


    'some examples of using the "queue-array utilities"
    bed_in_use = Count(arrayU) 'get the number of elements in arrayU
    Enqueue arrayU, "foo" ' add an element in the arrayU queue, it'll be placed at the queue end
    Enqueue arrayU, "bar" ' add another element in the arrayU queue, it'll be placed at the queue end
    bed_in_use = Count(arrayU) 'get the update number of elements in arrayU

    Dequeue arrayU 'shorten the queue by removing its first element
    myVar = Dequeue(arrayU) 'shorten the queue by removing its first element and storing it in "myvar"
    bed_in_use = Count(arrayU) 'get the update number of elements in arrayU

    MsgBox Peek(arrayU) ' see what's the first element in the queue


End Sub