Setting an array with an arbitary number of dimensions to base 0

Hi. I am trying to create a function in VBA that will take any array (so could have any number of dimensions), and shift it to base 0.

For instance, I want the function to be able to be able to take the following

Code:

---

dim outputArray() as variant
outputArray = myRebaseFunction(inputArray)

---

so inputArray(1 to 5, 3 to 6) would produce outputArray(0 to 4, 0 to 3), containing all the data of inputArray. Similarly, inputArray (2 to 4, 0 to 1, 3 to 7) would produce outputArray (0 to 2, 0 to 1, 0 to 4), containing all the data of inputArray. If the inputArray always had the same number of dimensions, it would be easy, but given the number of dimensions can be different for different inputArrays, does anyone know a way of dealing with this?

Thanks

Quote:

---

Originally Posted by dh273

Hi. I am trying to create a function in VBA

---

Moved To Office Development

you can try this

vb Code:

Function zerobaseall(arrinput As Variant) As Variant
strallbounds = getallbounds(arrinput)
numberofdimensions = Split(strallbounds, vbNewLine)
'you can now rewrite the array based on the content of number of dimensions
'note last element is empty
End Function
 
Sub test2()
Dim myarr As Variant
ReDim myarr(2 To 4, 0 To 1, 3 To 7)
x = zerobaseall(myarr)
End Sub
 
Function getallbounds(arrinput As Variant) As Variant
Dim tmp As Variant
 
On Error GoTo errh
For i = 1 To 100
    l = LBound(arrinput, i)
    u = UBound(arrinput, i)
    tmp = tmp & l & ":" & u & vbNewLine
Next
errh:
getallbounds = tmp
Err.Clear
End Function

Thanks for the response - this is roughly where I had got to myself, but not sure where to go from there, to turn the 1-D array 'numberofdimensions' (containing the array sizes as strings), into an actual array of the dimensions stored in the 'numberofdimensions' elements. If VBA6 had some kind of eval() function that could turn a string into executable code, i could see a way of doing it (see the pseudocode below), but given it doesn't, how would you create this new array?

Code:

---


Function getArrayBounds(arrayInput as variant) as variant
Dim arrayDimensions as string
On Error GoTo errh
arrayDimensions = "(" & LBound(arrayInput, 1) & " to " & UBound(arrayInput, 1)

For i = 2 To 100
    L = LBound(arrinput, i)
    U = UBound(arrinput, i)
    arrayDimensions = arrayDimensions &  ", " & 0 & " to " & (U - L) &
Next

errh:
    getArrayBounds = arrayDimensions
    Err.Clear
End Function

Sub CreateNewArray()
  dim oldArray(2 to 4, 0 to 1, 3 to 7)
  dim newArray() as variant
  eval("redim newArray(" & getArrayBounds(oldArray)  & ")" )
End Sub

---

One quick point is that in your OP, you declared:

dim outputArray() as variant

This isn't a variant array, but rather an array of variants. To accept generic arrays, I would recommend ditching the parentheses and sticking with a variant array.

As for you problem, here's a generic function to identify the number of dimensions:

Code:

---

' Returns 0 for unintialized array, -1 for non-array
Public Function ArrayDimensions(pvarArray As Variant) As Long
    Dim lngTemp As Long
    Dim i As Long
   
    On Error Resume Next
    Do
        i = i + 1
        lngTemp = UBound(pvarArray, i)
        Select Case Err.Number
            Case 13: ArrayDimensions = -1
            Case 9: ArrayDimensions = i - 1
        End Select
    Loop Until Err.Number
End Function

---

I can't think of a generic way to redimension a variable-dimension array. I'll keep it in mind, though.

Once that problem is corrected for and you create a blank array with the proper dimensions, it may be possible to use CopyMemory to copy the contents over from the original array in one line of code instead of a mess of nested loops.

Without CopyMemory -- or hacking the SafeArray definition directly -- copying the contents of the original array to the new one will present the same complexity as redimensioning it.

Quote:

---

Originally Posted by Ellis Dee

or hacking the SafeArray definition directly

---

This is the way to go. It's a straightforward process and pretty simple.

Arrays in VB6 are stored in SAFEARRAY structures. As you can see from that article, the structure pertinent to this questions is the tagSAFEARRAYBOUND structure. All that is required to do what you want is to identify all the tagSAFEARRAYBOUND entries for an array and change all the LBounds to 0. That's it. No data need be copied anywhere, so it'll be instantaneous even if your array has gigs of data.

Sadly, I don't actually know how to modify the SAFEARRAY headers directly. Others do, though, so I'll see if I can get them to post some code.

Complex maybe, but much faster than creating a new array:

Code:

---

Option Explicit

Private Type SafeArrayHeader
    Dimensions As Integer
    Features As Integer
    Length As Long
    Locks As Long
    Pointer As Long
End Type

Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long)

Public Function SetArrayBases(ByVal NotNotArray As Long, ParamArray Bases()) As Boolean
    Dim Bounds() As Long, Header As SafeArrayHeader, lngA As Long
    ' simple IDE error fix related to doing Not to an array that won't be compiled
    Debug.Assert App.hInstance
    ' basic requirements
    If UBound(Bases) >= 0 And NotNotArray <> 0 Then
        ' get the safe array header
        RtlMoveMemory Header, ByVal NotNotArray, LenB(Header)
        ' we consider it an error condition if there are more bases given than there are dimensions
        ' also, the array must NOT be in use by anything else (locked)
        If UBound(Bases) < Header.Dimensions And Header.Locks = 0 Then
            ' get bounds
            ReDim Bounds(Header.Dimensions * 2 - 1)
            RtlMoveMemory Bounds(0), ByVal NotNotArray + LenB(Header), CLng(Header.Dimensions) * 8
            ' now we simply go through the bases array and change the existing bases as we go
            For lngA = 0 To UBound(Bases)
                ' validate type to be fit for our needs
                Select Case VarType(Bases(lngA))
                    Case vbByte, vbInteger, vbLong
                        Bounds(lngA * 2 + 1) = Bases(lngA)
                    Case Else
                        ' on fail we simply exit and do nothing
                        Exit Function
                End Select
            Next lngA
            ' change bounds
            RtlMoveMemory ByVal NotNotArray + LenB(Header), Bounds(0), CLng(Header.Dimensions) * 8
            ' return True on success
            SetArrayBases = True
        End If
    End If
End Function

Private Sub Form_Load()
    Dim Test() As Long
    ReDim Test(2 To 3, 5 To 19)
    If SetArrayBases(Not Not Test, 0, 0) Then
        Debug.Print "Array base changed:"
        Debug.Print LBound(Test, 1) & " To " & UBound(Test, 1), LBound(Test, 2) & " To " & UBound(Test, 2)
    End If
End Sub

---

It also seems it is safe to do this to fixed size arrays since we are not changing the size of the array, only changing the base. You can do this trick to any array, even string arrays.

great code merri, i successfully used this to change base 0 to base 1 variant arrays, when passing the values for the new bases is there some easy way to know how many parameters to pass, how many dimensions in the array?

also i changed app.hinstance to true, as running in excel no app object, is that a good choice?

another question is is it possible to use like this to change # of dimensions or transpose dimensions?

App.hInstance is used to call just any VB environment function as this appears to fix a VB6 IDE bug (no more pointless errors when handling floating point numbers). I don't know whether this is required or not when in Office environment. If you don't get any weird errors when commenting out the entire line then everything is fine.

You can find out the number of dimensions from the Header.Dimensions, the shortest function you can come up with is:

Code:

---

Option Explicit

Private Declare Sub GetMem2 Lib "msvbvm60" (ByVal Address As Long, Value As Integer)

Public Function Dimensions(ByVal NotNotArray As Long) As Integer
    'Debug.Assert App.hInstance
    If NotNotArray Then GetMem2 NotNotArray, Dimensions
End Function

---

The number of dimensions is the first Integer in the safe array header structure so that is why this works. The problem is that you still have to pass the correct amount of parameters... thus you could go ahead and transform the function I made to take just one Long value instead of a ParamArray and just change all the dimensions to the same base instead of having a need to declare each individually (unless you have the need).


You may also find these API functions usable. They're a bit safer than hacking the safe array header directly, but may also have some limitations.

Edit!
A sample function (untested!):

Code:

---

Option Explicit

Private Declare Function SafeArrayGetDim Lib "oleaut32" (ByVal NotNotArray As Long) As Integer

Public Function Dimensions(ByVal NotNotArray As Long) As Integer
    'Debug.Assert App.hInstance
    Dimensions = SafeArrayGetDim(NotNotArray)
End Function

---

Awesome - thanks very much for your help!