Source code for Issue Number 42

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Just paste this source code into a module called basArrays and include it in your project.

'----------------------------------------------------------------------
'
'   Class Name:     basArrays
'   Written By:     C&D Programming Corp. and
'                   Phillip Fischer
'   Create Date:    5/98
'   Copyright:      Copyright 1998 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit

' Returns the number of dimensions in an array
' Uses the On Error (not a "clean" programming style , but it works)
' Developed by Phillip Fischer
' Modifications by C&D Programming Corp.
' When developing the Error Trapping should not be set to "Break on all
' Errors "
' ************************************************
Function DimensionCount(ByVal varArray As Variant) As Long
    Dim lngDimCounter As Long
    Dim lngDummy As Long

    On Error GoTo ErrDimensionCount

    ' if the data passed to us was not an array, just
    ' set the DimensionCount equal to zero and get out.
    If Not IsArray(varArray) Then
        DimensionCount = 0
        Exit Function
    End If

    ' Endless loop / exits this loop only once an error occurs
    Do While True
        lngDimCounter = lngDimCounter + 1
        lngDummy = UBound(varArray, lngDimCounter)
    Loop
    Exit Function

ErrDimensionCount:
    Select Case Err.Number
        Case 9 'subscript out of range
            ' The dimension that caused the Error - 1 is the number
            ' of dimensions in the array
            DimensionCount = lngDimCounter - 1
            Err.Clear      ' clean up error, just in case
        Case Else
            ' if an error other than subscript out of range occurs,
            ' something bad happened, so raise the error to the caller
            Err.Raise Err.Number, Err.Source, Err.Description
    End Select
End Function