In Excel via Visual Basic, I am iterating through a CSV file of invoices that is loaded into Excel. The invoices are in a determinable pattern by client.
I am readin
I know this is a bit old but I think there might be a much simpler solution that requires no additional coding:
Instead of transposing, redimming and transposing again, and if we talk about a two dimensional array, why not just store the values transposed to begin with. In that case redim preserve actually increases the right (second) dimension from the start. Or in other words, to visualise it, why not store in two rows instead of two columns if only the nr of columns can be increased with redim preserve.
the indexes would than be 00-01, 01-11, 02-12, 03-13, 04-14, 05-15 ... 0 25-1 25 etcetera instead of 00-01, 10-11, 20-21, 30-31, 40-41 etcetera.
As only the second (or last) dimension can be preserved while redimming, one could maybe argue that this is how arrays are supposed to be used to begin with. I have not seen this solution anywhere so maybe I'm overlooking something?
here is updated code of the redim preseve method with variabel declaration, hope @Control Freak is fine with it:)
Option explicit
'redim preserve both dimensions for a multidimension array *ONLY
Public Function ReDimPreserve(aArrayToPreserve As Variant, nNewFirstUBound As Variant, nNewLastUBound As Variant) As Variant
Dim nFirst As Long
Dim nLast As Long
Dim nOldFirstUBound As Long
Dim nOldLastUBound As Long
ReDimPreserve = False
'check if its in array first
If IsArray(aArrayToPreserve) Then
'create new array
ReDim aPreservedArray(nNewFirstUBound, nNewLastUBound)
'get old lBound/uBound
nOldFirstUBound = UBound(aArrayToPreserve, 1)
nOldLastUBound = UBound(aArrayToPreserve, 2)
'loop through first
For nFirst = LBound(aArrayToPreserve, 1) To nNewFirstUBound
For nLast = LBound(aArrayToPreserve, 2) To nNewLastUBound
'if its in range, then append to new array the same way
If nOldFirstUBound >= nFirst And nOldLastUBound >= nLast Then
aPreservedArray(nFirst, nLast) = aArrayToPreserve(nFirst, nLast)
End If
Next
Next
'return the array redimmed
If IsArray(aPreservedArray) Then ReDimPreserve = aPreservedArray
End If
End Function
You could do this array(0)= array(0,1,2,3)
.
Sub add_new(data_array() As Variant, new_data() As Variant)
Dim ar2() As Variant, fl As Integer
If Not (isEmpty(data_array)) = True Then
fl = 0
Else
fl = UBound(data_array) + 1
End If
ReDim Preserve data_array(fl)
data_array(fl) = new_data
End Sub
Sub demo()
Dim dt() As Variant, nw(0, 1) As Variant
nw(0, 0) = "Hi"
nw(0, 1) = "Bye"
Call add_new(dt, nw)
nw(0, 0) = "Good"
nw(0, 1) = "Bad"
Call add_new(dt, nw)
End Sub