A quick & simple VBA LIFO Stack Implementation with PUSH und POP





5.00/5 (1 vote)
VBA Hashtable Visual Basic Stack LIFO
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