New base for arrays?

• Question

• If I have an array of, let's say, three dimensions:
Array(35 To 75, 1 To 20, -11 To 22)

What's the smartest way to change the base of all the dimmensions of the array?

So, that it becomes:
Array(0 to 40, 0 To 19, 0 To 33)
...while preserving the vaules in the array.

And, keeping in mind that the dimmensions doesn't have to be three - in could be anything from 1 to 60.
And, the base could be 1 and not zero.

Anyone got a code for that?

Friday, November 11, 2016 9:47 AM

• What's the smartest way to change the base of all the dimmensions of the array?

Code below without any warranty!

Andreas.

```Option Explicit

'https://msdn.microsoft.com/en-us/library/windows/desktop/ms221482(v=vs.85).aspx

Private Type SafeArray
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
#If Win64 Then
pvData As LongPtr
#Else
pvData As Long
#End If
'rgSABound(0) As SafeArrayBound
End Type

Private Type SafeArrayBound
cElements As Long
lLbound As Long
End Type

#If Win64 Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal nCount As Long)
#Else
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal nCount As Long)
#End If

Private Sub Example_SetLBound()
Dim Arr
Dim i As Long, j As Long, k As Long
'Create an array
ReDim Arr(1 To 2, 3 To 4, 5 To 8)
'Fill
For i = LBound(Arr) To UBound(Arr)
For j = LBound(Arr, 2) To UBound(Arr, 2)
For k = LBound(Arr, 3) To UBound(Arr, 3)
Arr(i, j, k) = i & "-" & j & "-" & k
Next
Next
Next
'Set lower bound to 0
SetLBound Arr
'Show
Debug.Print
For i = LBound(Arr) To UBound(Arr)
For j = LBound(Arr, 2) To UBound(Arr, 2)
For k = LBound(Arr, 3) To UBound(Arr, 3)
Debug.Print "Before "; Arr(i, j, k), "After "; i & "-" & j & "-" & k
Next
Next
Next
End Sub

Sub SetLBound(ByRef vArray As Variant, Optional ByVal NewLBound As Long)
'Change the lower bound of all dimensions of an array
Const VT_BYREF = &H4000
#If Win64 Then
Dim vPtr As LongPtr
Dim vPtrFar As LongPtr
#Else
Dim vPtr As Long
Dim vPtrFar As Long
#End If
Dim vType As Integer, i As Integer, Ofs As Long
Dim SA As SafeArray
Dim SB() As SafeArrayBound
If Not IsArray(vArray) Then Exit Sub
If UBound(vArray) < LBound(vArray) Then Exit Sub
vPtr = VarPtr(vArray)
CopyMemory vType, ByVal vPtr, 2
If vType And VT_BYREF Then
CopyMemory vPtrFar, ByVal vPtr + 8, Len(vPtrFar)
CopyMemory vPtr, ByVal vPtrFar, Len(vPtr)
Else
CopyMemory vPtr, ByVal vPtr + 8, Len(vPtr)
End If
CopyMemory SA, ByVal vPtr, Len(SA)
ReDim SB(1 To SA.cDims)
#If Win64 Then
Ofs = 4 '!!AK: Not sure why, but works :-)
#Else
Ofs = 0
#End If
CopyMemory SB(1), ByVal vPtr + Len(SA) + Ofs, Len(SB(1)) * SA.cDims
For i = 1 To SA.cDims
SB(i).lLbound = NewLBound
Next
CopyMemory ByVal vPtr + Len(SA) + Ofs, SB(1), Len(SB(1)) * SA.cDims
End Sub```

• Marked as answer by Saturday, November 12, 2016 9:07 PM
Friday, November 11, 2016 3:20 PM

All replies

• That would be very complicated. You'll find code for a one-dimensional array at http://www.cpearson.com/excel/vbaarrays.htm

That code is already long and complex, using many helper functions. To expand it to work with an arbitrary number of dimensions would be a gargantuan task.

Better avoid the need for changing the bounds of an array!

Regards, Hans Vogelaar (http://www.eileenslounge.com)

Friday, November 11, 2016 12:57 PM
• What's the smartest way to change the base of all the dimmensions of the array?

Code below without any warranty!

Andreas.

```Option Explicit

'https://msdn.microsoft.com/en-us/library/windows/desktop/ms221482(v=vs.85).aspx

Private Type SafeArray
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
#If Win64 Then
pvData As LongPtr
#Else
pvData As Long
#End If
'rgSABound(0) As SafeArrayBound
End Type

Private Type SafeArrayBound
cElements As Long
lLbound As Long
End Type

#If Win64 Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal nCount As Long)
#Else
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal nCount As Long)
#End If

Private Sub Example_SetLBound()
Dim Arr
Dim i As Long, j As Long, k As Long
'Create an array
ReDim Arr(1 To 2, 3 To 4, 5 To 8)
'Fill
For i = LBound(Arr) To UBound(Arr)
For j = LBound(Arr, 2) To UBound(Arr, 2)
For k = LBound(Arr, 3) To UBound(Arr, 3)
Arr(i, j, k) = i & "-" & j & "-" & k
Next
Next
Next
'Set lower bound to 0
SetLBound Arr
'Show
Debug.Print
For i = LBound(Arr) To UBound(Arr)
For j = LBound(Arr, 2) To UBound(Arr, 2)
For k = LBound(Arr, 3) To UBound(Arr, 3)
Debug.Print "Before "; Arr(i, j, k), "After "; i & "-" & j & "-" & k
Next
Next
Next
End Sub

Sub SetLBound(ByRef vArray As Variant, Optional ByVal NewLBound As Long)
'Change the lower bound of all dimensions of an array
Const VT_BYREF = &H4000
#If Win64 Then
Dim vPtr As LongPtr
Dim vPtrFar As LongPtr
#Else
Dim vPtr As Long
Dim vPtrFar As Long
#End If
Dim vType As Integer, i As Integer, Ofs As Long
Dim SA As SafeArray
Dim SB() As SafeArrayBound
If Not IsArray(vArray) Then Exit Sub
If UBound(vArray) < LBound(vArray) Then Exit Sub
vPtr = VarPtr(vArray)
CopyMemory vType, ByVal vPtr, 2
If vType And VT_BYREF Then
CopyMemory vPtrFar, ByVal vPtr + 8, Len(vPtrFar)
CopyMemory vPtr, ByVal vPtrFar, Len(vPtr)
Else
CopyMemory vPtr, ByVal vPtr + 8, Len(vPtr)
End If
CopyMemory SA, ByVal vPtr, Len(SA)
ReDim SB(1 To SA.cDims)
#If Win64 Then
Ofs = 4 '!!AK: Not sure why, but works :-)
#Else
Ofs = 0
#End If
CopyMemory SB(1), ByVal vPtr + Len(SA) + Ofs, Len(SB(1)) * SA.cDims
For i = 1 To SA.cDims
SB(i).lLbound = NewLBound
Next
CopyMemory ByVal vPtr + Len(SA) + Ofs, SB(1), Len(SB(1)) * SA.cDims
End Sub```

• Marked as answer by Saturday, November 12, 2016 9:07 PM
Friday, November 11, 2016 3:20 PM
• Hi Andreas,

Seems to be working just fine :-)
At least with the arrays I've tested on, and need for my project...

Great work, and thank you for your time :-)

Saturday, November 12, 2016 9:09 PM