I am trying to convert a 1D array to a 2D. Below is where I am up to so far. I just need help with the Redim Preserve line. Can any of you nice array experts help out please? 
Public Function Convert1DArrayTo2D(varArrayInput As Variant) As Variant
Dim iCol As Integer
Dim varArrayOutput As Variant
' determine if input array is 1D. If not, return output same as input
If Not DetermineIfArrayIs1D_2D_OrMore(varArrayInput) = 1 Then
Convert1DArrayTo2D = varArrayInput
Exit Function
End If
ReDim varArrayOutput(LBound(varArrayInput) To UBound(varArrayInput), 0)
' for each column in the 1D Input Array
For iCol = LBound(varArrayInput) To UBound(varArrayInput)
' copy data into Output Array
varArrayOutput(iCol, 0) = varArrayInput(iCol)
Next iCol
' add one extra row to Output Array (will contain empty values)
Debug.Print "it will crash on the next code line 'subscript out of range'"
ReDim Preserve varArrayOutput(iCol - 1, 1) 'already tried ReDim Preserve varArrayOutput(iCol - 1, UBound(varArrayOutput,2)+1)
' return function as Output array (transpose so array is in (rows,cols) format)
Convert1DArrayTo2D = WorksheetFunction.Transpose(varArrayOutput)
End Function
Public Function DetermineIfArrayIs1D_2D_OrMore(ByVal varArray As Variant) As Integer
' returns number of dimensions as 1, 2 or 3 (3 is for anything above 2. I only have a practical use for determining the size below 3).
Dim bytDimNum As Byte
Dim varErrorCheck As Variant
On Error GoTo FinalDimension
For bytDimNum = 1 To 3
varErrorCheck = LBound(varArray, bytDimNum)
Next
FinalDimension:
On Error GoTo 0
DetermineIfArrayIs1D_2D_OrMore = bytDimNum - 1
End Function
Bookmarks