Click here to Skip to main content
Click here to Skip to main content

Tagged as

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

, 8 Jul 2010 CPOL
Rate this:
Please Sign up or sign in to 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

License

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

Share

About the Author

Stefan Huy
Engineer
Germany Germany
No Biography provided
Follow on   Twitter   LinkedIn

Comments and Discussions

 
GeneralFew short explanation..... PinmvpMd. Marufuzzaman7-Jul-10 10:24 

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

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

| Advertise | Privacy | Terms of Use | Mobile
Web04 | 2.8.141030.1 | Last Updated 8 Jul 2010
Article Copyright 2010 by Stefan Huy
Everything else Copyright © CodeProject, 1999-2014
Layout: fixed | fluid