Hi,
I have done variations of all the above in answering Threads quite a few times, so I thought a Thread on it here would not go a miss.
Many of us will know that VBA only allows you to change the last dimension ( “column”) in a 2 D Array whilst Preserving the current contents.
It may also be known that a simple workaround is to transpose the Array, Re Dim Preserve on the last dimension of the transposed Array, then transpose back.
Further, The Worksheet Function Transpose has some limitation such as size restrictions and a few other weird quirks
https://newtonexcelbach.wordpress.co...2013-and-2016/
http://excelmatters.com/2016/03/08/t...2013-and-2016/
_...and simple looping is often quicker anyway, so that is convenient to do here as well, Function(s) to do that which are then used in place of the Worksheet Function Transpose.
One further observation: It is often said that an Array cannot be passed ByValue. Only if one is pedantic defining an Array specifically in such a form arr() is that really the case. If we consider an Array as a "Field of elements filled with Variables", then this allows us to pass "it" ByValue. So the Functions are done in such a way as to allow the passing ByValue ( or ByReferrence )
http://www.mrexcel.com/forum/excel-q...l-byref-3.html
http://www.mrexcel.com/forum/excel-q...t-error-2.html
http://www.mrexcel.com/forum/excel-q...l-byref-2.html ( some minor typos )
So initially,
_1 ) just for completeness and comparison, a simple Function which does use the Worksheets Function Transpose. It assumes that we are dealing with a 2 Dimensional Array, both for the input Array and output Re Dimensioned Array. As in all cases I am assuming you want to enlarge the Array, but I think they would all work to “chop off a row”, although there are more efficient ways to do that, for example
http://www.excelfox.com/forum/f22/de...nt-array-2083/
Function and a calling Code to test Worksheets Function .Transpose way
' Simple ReDim Preserve "Vertically" - Two codes the calling Demo code and the Function uses Worksheet Function .Transpose
Sub EnlargeVirticallyInFieldF()
Dim MyArray() As Variant ' Dynamic Array of Variant Types. Althougth we intend giving it a size, but it will be changed of course in our experiments, so it cannot be a fixed ( static ) Array
ReDim MyArray(1 To 7, 1 To 2)
MyArray() = TwoDArrayReDimPreserveFirstIndicie(MyArray, 8) 'The Array should be increased "vertically" to 8 "rows"
'MyArray is now 1 to 8, 1 to 2
End Sub
'
Public Function TwoDArrayReDimPreserveFirstIndicie(ByVal arrIn As Variant, ByVal FirstIndicieIncreaseTo As Long) As Variant 'This Fuction returns an Array, the only type that can handle that is Variant. Note also (ByVal arrIn As Variant can not be (ByVal arrIn() as Variant, ) as this errors. It accepts (Byref arrIn() as Variant, but then it can fall down, should we pass a Variant housing an Array. We are now "Housing" our Array within the Variant structure which is very contentious.. see the detailed Mr excel Threads ------ http://www.mrexcel.com/forum/excel-questions/917689-passing-array-class-byval-byref.html
Dim arrTemp() As Variant: Let arrTemp() = arrIn ' We could use arrIn Directly as indeed we do in one line.. Extra steps can sometimes assist withh debugging.
Let arrTemp() = Application.WorksheetFunction.Transpose(arrIn) 'We "Turn it 90°" , ( Transpose ) as we ReDim Preserve and this will not allow increasing or decreasing first indicie, which we want to do, but....
ReDim Preserve arrTemp(1 To UBound(arrTemp, 1), 1 To FirstIndicieIncreaseTo) ' ....ReDim Preserve will allow second indicie to be increased or decreased
Let arrTemp() = Application.WorksheetFunction.Transpose(arrTemp()) 'Having actually ReDim Preserved the indicie we wanted to, we re Transppose to get it back in original orientatiion
Let TwoDArrayReDimPreserveFirstIndicie = arrTemp() 'This line makes the Function in a calling code return arrTemp() which is our final wanted result from this Function working with the input arguments given , ( arrIn and FirstIndicieIncreaseTo ) in the calling Line
End Function
_................................................
Then two basic pairs of Functions. The first function is the Function to Re Dim Preserve the first Dimension, or “row”. The second function is the VBA Looping alternative to the Worksheets Function transpose which the First Function Calls twice.
_2a) and 2 b). : The first pair are simple assuming that we are dealing with a 2 Dimensional Array, both for the input Array and output Re Dimensioned Array
_...................
_3)
_3b) In the second pair, the Second Function is intended to mimic exactly the Worksheet Function transpose, which will accept a 1 D Array, transposing it to a 1 Column 2 D Array, as well as in reverse returning a 1 D Array when given 1 column 2 D array.
_3a) Also the first function mimics partly, the VBA Re Dim Preserve, in as far as that it will accept a 1 D Array, although as with both Re Dim Preserve Functions given here they are intended to add a “column”
_.................................
I give the codes simplified here, with a demo calling code, , then in the next Posts a bit more detailed with lots of explaining ‘green comments for anyone interested
_2 ) ' Demo Code to call Functions. The First Function calls the second twice as necerssary to do the Transposing
'
Sub Demo_2() ' Demo Code to call Functions. The First Function calls the second twice as necerssary to do the Transposing ' assuming that we are dealing with a 2 Dimensional Array, both for the input Array and output Re Dimensioned Array
Dim MyArray() As Variant
ReDim MyArray(1 To 7, 1 To 2)
MyArray() = SHimpfGlifiedReDimRow_2(MyArray, 8)
'MyArray is now 1 to 8, 1 to 2
End Sub
Public Function SHimpfGlifiedReDimRow_2(ByVal arrIn As Variant, ByVal FirstIndicieIncreaseTo As Long)
Let arrIn = SHimpfGlifiedFT(arrIn) 'Note you cannot simplify further and use SHimpfGlifiedReDimRow as LHS here and furhter in code as Re Dim errors
ReDim Preserve arrIn(1 To UBound(arrIn, 1), 1 To FirstIndicieIncreaseTo)
Let SHimpfGlifiedReDimRow_2 = SHimpfGlifiedFT(arrIn)
End Function
Public Function SHimpfGlifiedFT(ByVal inArr As Variant)
Dim outArr() As Variant: ReDim outArr(1 To UBound(inArr, 2), 1 To UBound(inArr, 1))
Dim j As Long, i As Long
For j = 1 To UBound(inArr, 1)
For i = 1 To UBound(inArr, 2)
outArr(i, j) = inArr(j, i)
Next i
Next j
Let SHimpfGlifiedFT = outArr()
End Function
'
_..........................
_3) 'The following set of Codes , to complete the picture, mimic the .Transpose. But again with simple looping to overcome the size limitations.
' 'The following set of Codes , to complete the picture, mimic the .Transpose. But again with simple looping to overcome the size limitations. The important distinguishing characteristics here are that _ it will take a 1 dimensional Array, ( and return it enlarged appropriately ) _ The second Function, the Transpose Function, actually will return a 1 Dimensional Array when given a 1 "column" 2 Dimentsional Array as the VBA .Transpose function itself does
Sub Demo_3() '
Dim MyArray() As Variant
ReDim MyArray(1 To 7, 1 To 2)
Let MyArray() = SHimpfGlifiedReDimRow_3(MyArray, 8)
'MyArray is now 1 to 8, 1 to 2
ReDim MyArray(1 To 7, 1 To 1)
Let MyArray() = SHimpfGlifiedReDimRow_3(MyArray, 8)
'MyArray is now 1 to 8, 1 to 1
ReDim MyArray(1 To 2) ' base ( 1 ) 1 D "pseudo" horizontal Array
Let MyArray() = SHimpfGlifiedReDimRow_3(MyArray, 8)
'MyArray is now 1 to 8, 1 to 2
ReDim MyArray(0 To 1) ' base ( 0 ) 1 D "pseudo" horizontal Array
Let MyArray() = SHimpfGlifiedReDimRow_3(MyArray, 8)
'MyArray is now 1 to 8, 1 to 2
End Sub
Public Function SHimpfGlifiedReDimRow_3(ByVal arrIn As Variant, ByVal FirstIndicieIncreaseTo As Long)
Dim arrTemp() As Variant
arrTemp() = arrIn
arrTemp() = SHimpfGlifiedFTT(arrIn)
On Error Resume Next
If UBound(arrTemp(), 2) = -1234 Then
On Error GoTo 0
Else
ReDim Preserve arrTemp(1 To UBound(arrTemp(), 1), 1 To FirstIndicieIncreaseTo)
End If
Let SHimpfGlifiedReDimRow_3 = arrTemp()
End Function
Public Function SHimpfGlifiedFTT(ByVal inArr As Variant) As Variant
Dim i As Long
On Error Resume Next
If UBound(inArr, 2) = 0 Then
On Error GoTo 0
Dim ii As Long
Dim outArr() As Variant
ReDim outArr(1 To ((UBound(inArr) - LBound(inArr)) + 1), 1 To 1)
For ii = LBound(inArr) To UBound(inArr) Step 1
i = i + 1
outArr(i, 1) = inArr(ii)
Next ii
SHimpfGlifiedFTT = outArr()
Else
ReDim outArr(1 To UBound(inArr, 2), 1 To UBound(inArr, 1))
Dim j As Long
If UBound(inArr, 2) = 1 Then
Dim OneDArr() As Variant: ReDim OneDArr(1 To UBound(inArr, 1))
For j = 1 To UBound(inArr, 1)
OneDArr(j) = inArr(j, 1)
Next j
SHimpfGlifiedFTT = OneDArr()
Else
For j = 1 To UBound(inArr, 1)
For i = 1 To UBound(inArr, 2)
outArr(i, j) = inArr(j, i)
Next i
Next j
SHimpfGlifiedFTT = outArr()
End If
End If
End Function
Bookmarks