Private ErrMsg As String
Private StackIsEmpty As Boolean
Private Type LIFO_StackType
value As Variant
End Type
Private Function InitializeStack(lifo() As LIFO_StackType) As Boolean
ErrMsg = ""
On Error GoTo InitErr
ReDim lifo(0)
StackIsEmpty = True
InitializeStack = True
Exit Function
InitErr:
InitializeStack = False
ErrMsg = Err.Description
End Function
Private Function Push(lifo() As LIFO_StackType, value As Variant) As Boolean
ErrMsg = ""
On Error GoTo PushErr
If IsEmpty(value) Or IsNull(value) Or value = "" Then Err.Raise 9999, , "No value to handle"
Dim idx As Long
Dim lifoVal As LIFO_StackType
lifoVal.value = value
idx = UBound(lifo) + 1
ReDim Preserve lifo(idx)
lifo(idx) = lifoVal
StackIsEmpty = False
Push = True
Exit Function
PushErr:
Push = False
ErrMsg = Err.Description
End Function
Private Function Pop(lifo() As LIFO_StackType) As Variant
ErrMsg = ""
On Error GoTo PopErr
If UBound(lifo) = 0 Then
StackIsEmpty = True
Err.Raise 9998, , "Stack is empty"
End If
idx = UBound(lifo) + 1
Pop = lifo(UBound(lifo)).value
Dim lifoTmp() As LIFO_StackType
ReDim lifoTmp(UBound(lifo) - 1)
If UBound(lifo) > 1 Then
For i = 0 To UBound(lifo) - 1
lifoTmp(i).value = lifo(i).value
Next i
lifo = lifoTmp
Else
ReDim lifo(0)
StackIsEmpty = True
End If
Exit Function
PopErr:
Pop = ""
ErrMsg = Err.Description
End Function
Private Function GetStackCount(stack() As LIFO_StackType) As Long
If StackIsEmpty Then GetStackCount = 0 Else GetStackCount = UBound(stack)
End Function
Public Sub Test_Stack()
'Create a variable for the stack:
Dim stack() As LIFO_StackType
'Initializing the stack: InitializeStack(stack)
Debug.Print "Initialize: " & InitializeStack(stack)
Debug.Print ""
Debug.Print "*** Push Test Values:"
'Pushing some values: Push(stack, value)
Debug.Print "Push Test1: " & Push(stack, "Test 1")
Debug.Print "Push Test2: " & Push(stack, "Test 2")
Debug.Print "Push Test3: " & Push(stack, "Test 3")
Debug.Print "Push Test4: " & Push(stack, "Test 4")
Debug.Print "Push Test5: " & Push(stack, "Test 5")
Debug.Print "Push Null : " & Push(stack, Null)
Debug.Print ""
Debug.Print "*** Pop all Stack Values:"
'Removing/Getting the values Pop(stack)
Do While Not StackIsEmpty
Debug.Print "Pop LastIn: " & GetStackCount(stack) & " - " & Pop(stack)
Loop
Debug.Print "Pop LastIn: " & GetStackCount(stack) & " - " & Pop(stack)
End Sub