Skip to content

Instantly share code, notes, and snippets.

@wizard04wsu
Last active July 1, 2020 17:57
Show Gist options
  • Save wizard04wsu/8826741 to your computer and use it in GitHub Desktop.
Save wizard04wsu/8826741 to your computer and use it in GitHub Desktop.
VBScript or VBA array functions
Function getUBound(arr)
getUBound = -1
On Error Resume Next
getUBound = UBound(arr)
On Error GoTo 0
End Function
Function getLength(arr)
getLength = getUBound(arr) + 1
End Function
Sub push(arr, item)
Dim newIndex: newIndex = getUBound(arr) + 1
ReDim Preserve arr(newIndex)
On Error Resume Next
arr(newIndex) = item
On Error GoTo 0
If Err.Number <> 0 Then Set arr(newIndex) = item
End Sub
Function pop(arr)
Dim top: top = getUBound(arr)
If top < 0 Then 'array is empty
pop = Null
Else
On Error Resume Next
pop = arr(top)
On Error GoTo 0
If Err.Number <> 0 Then Set pop = arr(top)
ReDim Preserve arr(top - 1)
End If
End Function
Sub unshift(arr, item)
Dim i, top: top = getUBound(arr)
ReDim Preserve arr(top + 1)
For i = top + 1 To 1 Step -1
On Error Resume Next
arr(i) = arr(i - 1)
On Error GoTo 0
If Err.Number <> 0 Then Set arr(i) = arr(i - 1)
Next
On Error Resume Next
arr(0) = item
On Error GoTo 0
If Err.Number <> 0 Then Set arr(0) = item
End Sub
Function shift(arr)
Dim i, top: top = getUBound(arr)
If top < 0 Then 'array is empty
shift = Null
Else
On Error Resume Next
shift = arr(0)
On Error GoTo 0
If Err.Number <> 0 Then Set shift = arr(0)
For i = 1 To top
On Error Resume Next
arr(i - 1) = arr(i)
On Error GoTo 0
If Err.Number <> 0 Then Set arr(i - 1) = arr(i)
Next
ReDim Preserve arr(top - 1)
End If
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment