Click here to Skip to main content
65,938 articles
CodeProject is changing. Read more.
Articles / Languages / VBScript

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

5.00/5 (1 vote)
8 Jul 2010CPOL 31.3K  
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

License

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