'Module:        Arrays
'Purpose:       Generic array procedures
'VB Version:    Excel 97 SR-1
'Written by:    David Crawford
'
Option Explicit
'
'Purpose:   Return the number of dimensions an array has.
'Example:   GetDimensions(Array("A")) -> 1
'
Function GetDimensions(ArrayRef As Variant) As Integer
On Error GoTo HandleErrors
    
    Dim Dimension As Integer
    Dim UpperBound As Long
        
    'start with one dimension
    Dimension = 1
    
    'increase dimensions until an error occurs
    Do While True
        UpperBound = UBound(ArrayRef, Dimension)
        Dimension = Dimension + 1
    Loop
    
ExitProcedure:
    Exit Function
    
HandleErrors:
    GetDimensions = Dimension - 1
    Resume ExitProcedure
    
End Function
'
'Purpose:   Sort a one dimensional array in ascending order. This subroutine
'           can be used to sort the file names array returned by Dir().
'
Sub SortArray(ArrayRef As Variant)
On Error GoTo HandleErrors

    
    Dim ArrayIndex As Integer
    Dim ArrayLower As Integer
    Dim ArraySorted As Boolean
    Dim ArrayUpper As Integer
    Dim CurrentElement As Variant
        
    'get lower and upper bounds of arrayRef
    ArrayLower = LBound(ArrayRef)
    ArrayUpper = UBound(ArrayRef)
    
    'loop until array is sorted
    ArraySorted = False
    Do While ArraySorted = False
    
        'assume arrayRef is sorted
        ArraySorted = True
        
        For ArrayIndex = ArrayLower To ArrayUpper - 1
            
            'If current element and next element are not in order
            If ArrayRef(ArrayIndex) > ArrayRef(ArrayIndex + 1) Then
                
                'switch current and next element
                CurrentElement = ArrayRef(ArrayIndex)
                ArrayRef(ArrayIndex) = ArrayRef(ArrayIndex + 1)
                ArrayRef(ArrayIndex + 1) = CurrentElement
                ArraySorted = False
                
            End If
            
        Next ArrayIndex
        
    Loop
    
ExitProcedure:

    Exit Sub

HandleErrors:

    'if subscript error array is probably empty
    If Err = 9 Then
    
        'do nothing
        Resume ExitProcedure
        
    'else something else went wrong
    Else
    
        'warn user
        MsgErr "Push", Err
        Resume ExitProcedure
        
    End If
    
End Sub
'
'
'
Sub Delete(DeleteArray As Variant, DeleteElement As Long)

    Dim ArrayUbound As Long
    Dim ArrayElement As Long
    
    'get size of array
    ArrayUbound = UBound(DeleteArray, 1)

    'move elements above element deleted down
    For ArrayElement = DeleteElement To ArrayUbound - 2
        DeleteArray(ArrayElement) = DeleteArray(ArrayElement + 1)
    Next ArrayElement
    
    'if array has more than one element resize array
    If ArrayUbound > 0 Then
        ReDim Preserve DeleteArray(ArrayUbound - 1)
    End If

End Sub
'
'
'
Sub Insert(OneDimArray As Variant, InsertBefore As Long, Value As Variant)

    Dim ArrayUbound As Long
    Dim ArrayElement As Long
    
    'get size of array
    ArrayUbound = UBound(OneDimArray, 1)
    
    'resize array
    ReDim Preserve OneDimArray(ArrayUbound + 1)

    'move elements above inserted element up
    For ArrayElement = ArrayUbound To InsertBefore Step -1
        OneDimArray(ArrayElement + 1) = OneDimArray(ArrayElement)
    Next ArrayElement
    
    'insert value
    OneDimArray(InsertBefore) = Value

End Sub