Getting dimensions of dynamic arrays 2

[stevexff]

I know I can use Ubound and Lbound to find the size of the dimensions of a dynamic array. But is there anything I can use to determine the number of dimensions the array has at run time? I was hoping that Ubound(Array, n) would return something friendly like 0 or -1 if the dimension didn't exist, but it just bombs with subscript out of range.

Why, you might ask? Well, I'm refactoring an application that loads dozens of n-dimensional tables from files, and I want to write a utility method that compares two arrays so I can verify that the new method loads the arrays the same as the old method...

Of course, if there's a better way to do this like a nice simple CompareArray() function, then that would be even better!

Steve

[small]"Every program can be reduced by one instruction, and every program has at least one bug. Therefore, any program can be reduced to one instruction which doesn't work." (Object:erlDesignPatterns)[/small]

 

[SkipVought]

Hi,

Sub test()
    Dim a(2, 3, 4), i
    On Error Resume Next
    i = 1
    Do While Err.Number = 0
        MsgBox UBound(a, i)
        i = i + 1
    Loop
    On Error GoTo 0
End Sub

Skip,

_{To be safe on the [red]FOURTH[/red],
Don't take a [red]FIFTH[/red] on the [red]THIRD[/red]
Or you might not come [red]FORTH[/red] on the [red]FIFTH[/red]
[red][highlight blue]FORTH[/highlight][/red][white][highlight red]WITH[/highlight][/white]}

 

[CautionMP]

stevexff,
I was thinking something along the same lines as SkipVought, trap the error and let it tell you when you reached the highest dimension.

Public Function UpperDim(YourArray() As Variant) As Long
On Error Resume Next
Dim lngBuffer As Long
Do
  UpperDim = UpperDim + 1
  lngBuffer = UBound(YourArray, UpperDim)
Loop Until Err.Number <> 0
UpperDim = UpperDim - 1
Err.Clear
End Function

Hope this helps,
CMP

[small]For the best results do what I'm thinking, not what I'm saying.[/small]
(GMT-07:00) Mountain Time (US & Canada)

 

[stevexff]

Cheers Skip, I'll give it a try.

Steve

[small]"Every program can be reduced by one instruction, and every program has at least one bug. Therefore, any program can be reduced to one instruction which doesn't work." (Object:erlDesignPatterns)[/small]

 

[stevexff]

Works perfectly! Stars all round, I think...

Steve

[small]"Every program can be reduced by one instruction, and every program has at least one bug. Therefore, any program can be reduced to one instruction which doesn't work." (Object:erlDesignPatterns)[/small]

 

[SkipVought]

Steve,
Thank you, I think... ;-)

Skip,

_{To be safe on the [red]FOURTH[/red],
Don't take a [red]FIFTH[/red] on the [red]THIRD[/red]
Or you might not come [red]FORTH[/red] on the [red]FIFTH[/red]
[red][highlight blue]FORTH[/highlight][/red][white][highlight red]WITH[/highlight][/white]}

 

[SkipVought]

...therefore I am!

Skip,

_{To be safe on the [red]FOURTH[/red],
Don't take a [red]FIFTH[/red] on the [red]THIRD[/red]
Or you might not come [red]FORTH[/red] on the [red]FIFTH[/red]
[red][highlight blue]FORTH[/highlight][/red][white][highlight red]WITH[/highlight][/white]}

 

[combo]

An alternative way via the direct access to the memory:

' from [URL unfurl="true"]http://www.xtremevbtalk.com/archive/index.php/t-252050.html[/URL]

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Long, Source As Long, ByVal ByteLen As Long)

Public Function NumberOfArrayDimensions(ByVal anArray As Variant) As Integer

Dim arrayPointer As Long
Dim SafeArrayAddress As Long
Dim nDims As Long

CopyMemory arrayPointer, ByVal VarPtr(anArray) + 8, ByVal 4 'get a pointer to the array
CopyMemory SafeArrayAddress, arrayPointer, ByVal 4 'gets the safearray address
If SafeArrayAddress <> 0 Then 'if the array has been dimensioned then address <> 0 otherwise address = 0
CopyMemory nDims, ByVal SafeArrayAddress, 2 'the first two bytes of the safearray's address
'are the number of dimensions in the array
Else
nDims = 0 'The array hasnt been initialized so it doesnt have any dimensions
End If
NumberOfArrayDimensions = nDims
End Function

combo