Click here to Skip to main content
15,881,248 members
Articles / Programming Languages / VBScript
Tip/Trick

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

Rate me:
Please Sign up or sign in to vote.
5.00/5 (1 vote)
8 Jul 2010CPOL 30.8K   2   1
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)


Written By
Engineer
Germany Germany
This member has not yet provided a Biography. Assume it's interesting and varied, and probably something to do with programming.

Comments and Discussions

 
GeneralFew short explanation..... Pin
Md. Marufuzzaman7-Jul-10 10:24
professionalMd. Marufuzzaman7-Jul-10 10:24 

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

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