Related
How do I combine these arrays with the outcome of (2, 4, 5, 3, 7, 6)?
array1 = Array(4,5,3,7,6)
array2 = Array(2)
You could potentially Join() and concatenate your two arrays, and then Split() the result back to a new array:
array3 = Split(Join(array2, ",") & "," & Join(array1, ","), ",")
Explanation:
Join() will return a string that has each element in the array (first parameter) delimited by a "," (second parameter). We concatenate those two joined arrays with one more comma to get a string like 2,4,5,3,7,6. We then use Split() to turn that string back into an array telling Split() that the delimter is a comma ",".
You could use arrayLists. This also provides for an easy sort if wanted.
Option Explicit
Public Sub test()
Dim list1 As Object, list2 As Object
Set list1 = CreateObject("System.Collections.Arraylist")
Set list2 = CreateObject("System.Collections.Arraylist")
list1.Add 4
list1.Add 5
list1.Add 3
list1.Add 7
list1.Add 6
list2.Add 2
list1.addRange list2
list1.Sort
End Sub
Joining two arrays
As an alternative to the correct and working approach proposed by Scott Craner
Create a third array that is empty the size of both arrays combined,
then loop through each array adding the items one by one.
... I demonstrate a way to
insert only the element(s) of the 2nd array by a loop
into a main array, whereas
the main array gets only restructured by a one liner via Application.Index().
As this function would change results to a 1-based array, I redimension the array back to a zero-based one. Furthermore I added an optional display in the VBE's Immediate Window resulting to 2|4|5|3|7|6 values:
1st step: Simple demo with same array values as in OP (Insertion of 1 element)
Sub SimpleDemo()
'[0]declare and assign zero-based 1-dimensioned arrays
Dim main, newTop
main = Array(4, 5, 3, 7, 6)
newTop = Array(2) ' only one element in a first step
'[1]transform main array by inserting(/i.e. repeating) "another" 1st element
main = Application.Index(main, Array(1, 1, 2, 3, 4, 5)) ' changes to 1-based 1-dim array
ReDim Preserve main(0 To UBound(main) - 1) ' back to zero-based 1-dim array
'[2]overwrite new first element by the 1st(only) element of newTop
main(0) = newTop(0)
'[3](optional) display in VBE's Immediate Window: main(0 To 5) ~> 2|4|5|3|7|6
Debug.Print "main(" & LBound(main) & " To " & UBound(main) & ") ~> " & _
Join(main, "|")
End Sub
2nd step: More generalized approach using a AddElem procedure
The above demo inserts only one element. Therefore I coded a AddElem procedure and a help function addedElems() to allow the insertion of more elements. Assumption is made that all 1-dim arrays are zero-based as in the original post; could be adapted easily btw :-)
Sub AddElem(main, newTop)
' Purp. : add/insert other array element(s) on top of zero-based main array
' Author: https://stackoverflow.com/users/6460297/t-m
' Date : 2020-02-05
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' a)insert newTop element(s) on top of main array
main = Application.Index(main, addedElems(main, newTop)) ' changes temporarily to 1-based mainay!
' b)make main array zero-based again (optional)
ReDim Preserve main(0 To UBound(main) - 1)
' c)overwrite inserted starting element(s) by the newTop element(s)
Dim i&: For i = 0 To UBound(newTop): main(i) = newTop(i): Next i
End Sub
Help function addedElems()
Function addedElems(main, newTop) As Variant()
'Note : help function called by AddElem()
'Purp.: return ordinal element counters of combined arrays
Dim i&, n&: n = UBound(main) + UBound(newTop) + 1
ReDim tmp(0 To n)
For i = 0 To UBound(newTop): tmp(i) = i: Next i
For i = i To n: tmp(i) = i - UBound(newTop): Next i
addedElems = tmp ' return combined elem counters, e.g. Array(1,2, 1,2,3,4,5)
End Function
Example call
I changed the values of OP's second array slightly (Array(2) ~>Array(20,21) to demonstrate the insertion of more elements, thus
resulting in a combined Array(20,21,2,4,5,3,7,6).
Sub ExampleCall()
'[0]declare and assign zero-based 1-dimensional arrays
Dim main, newTop
main = Array(4, 5, 3, 7, 6)
newTop = Array(20, 21)
'[1]Add/Insert newTop on top of main array
AddElem main:=main, newTop:=newTop ' or simply: AddElem main, newTop
'[2](optional) display in VBE's Immediate Window: ~~> main(0 To 6) ...20|21|4|5|3|7|6
Debug.Print "main(" & LBound(main) & " To " & UBound(main) & ") ..." & _
Join(main, "|")
End Sub
Related link
Similarly you can study some pecularities of the Application.Index() function applied on 2-dim arrays at Insert first column in datafield array without loops or API calls
Late to the party, but I'll also add my two cents
You could simply copy one of the two arrays into a new array. Then Redim Preserve that to be the size of the two original arrays to then loop only the first array. The following code is basic, but does the job quick without converting any data type:
Sub Test()
Dim arr1 As Variant: arr1 = Array(4, 5, 3, 7, 6)
Dim arr2 As Variant: arr2 = Array(2)
Dim arr3 As Variant: arr3 = arr2
ReDim Preserve arr3(UBound(arr1) + Ubound(arr2) + 1)
For x = (UBound(arr3) - UBound(arr1)) To UBound(arr3)
arr3(x) = arr1(x - UBound(arr2) - 1)
Next x
End Sub
To demonstrate the return of different Data Type using some Type conversions:
Sub Test()
Dim arr1 As Variant: arr1 = Array(CDbl(4), CLng(5), CStr(3), CDate(7), CCur(6))
Dim arr2 As Variant: arr2 = Array(2)
Dim arr3 As Variant: arr3 = arr2
ReDim Preserve arr3(UBound(arr1) + Ubound(arr2) + 1)
For x = (UBound(arr3) - UBound(arr1)) To UBound(arr3)
arr3(x) = arr1(x - UBound(arr2) - 1)
Next x
End Sub
I have a spreadsheet with 40K rows and 3 columns of strings that I need loaded into an array. How can I load an array such that I iterate through the sheet to load the values? Then end goal is that I fill the array so that I can then go through the array and say this value goes to this spreadsheet and that value goes in another spreadsheet. I have it working for a spreadsheet of 2 columns but the newest twist comes with 3 columns and trying to adapt my 2D version into 3D errors out.
ReDim arrTwoD(1 To intRows + 1, 1 To intCols + 1)
For i = 1 To UBound(arrTwoD, 1)'really a 3D now. or at least it needs to be
For j = 1 To UBound(arrTwoD, 2)
For k = 1 To UBound(arrTwoD, 3)
arrTwoD(i, j, k) = Sheets("ExistingLFItems").Cells(i, j, k)
Debug.Print i, j, k, arrTwoD(i, j, k)
Next k
Next j
Next i
Say We have 3 columns, A, B, and C with data from A1 through C40000. This will fill an array with the contents of these columns:
Sub RangeToArray()
Dim arr() As Variant
arr = Range("A1:C40000").Value
MsgBox LBound(arr, 1) & "-" & LBound(arr, 2) & vbCrLf & UBound(arr, 1) & "-" & UBound(arr, 2)
End Sub
This is the exact equivalent of:
Dim arr(1 to 40000,1 to 3) As String
and filling the array with a double loop.
No matter how hard you try, a sheet is only a 2D array. You can simplify your code by doing something like:
Sub test()
Dim foo
foo = Application.Transpose(Selection)
End Sub
Obviously you'll need to change 'Selection' to be your range, but this should get you started. If you set a break point on End Sub and see what foo is, you'll notice that it is a 2D array where the first value is the column reference and the 2nd value is the row reference.
Also, as pointed out in the comments, you can omit the Transpose and do this:
Sub test()
Dim foo2
foo2 = Sheet1.Range("A1:C3").Value
End Sub
Both yield the similar results.
I'm trying to get a 2D array of size [x][3] filled. X is just the size of the sheet (number of rows) and there are 3 columns which I am interested in. The columns are not near each other, for instance arr[i][0] should be filled from column AA, arr[i][1] should come from column K, and arr[i][2] needs to be from columns L.
I tried assigning it the following way, but got an error in the array value assignment.
Any help on this would be greatly appreciated!
Code:
Sub SOC_work()
'Trying to sort each of the disciplines further, by Stage of Construction
Dim ar_SOC() As Variant
Dim int_NumRows As Long
Dim i_counter As Long
Dim j_Counter As Long
Dim lite As Range
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Sheets("AVEVA_PBOM_PARTS").Select
'Redimension the array size to the amount of parts in the PBOM
int_NumRows = ActiveSheet.UsedRange.Rows.count - 1
ReDim ar_SOC(int_NumRows, 3)
'now assignt he range into the array space
lite = Range("AA2", Range("AA2").End(xlDown))
ar_SOC[][1]=lite
End Sub
Is there any way to do this without looping through the entire column?
As described in the comments, you can fill three 2-D arrays. You can then populate a fourth array from the three arrays, like below.
Sub populateArray()
Dim arrColOne() As Variant, arrColTwo() As Variant, arrColThree() As Variant
Dim arrAllData() As Variant
Dim i As Long
arrColOne = Range("A2:A" & lrow(1)) 'amend column number
arrColTwo = Range("D2:D" & lrow(4))
arrColThree = Range("G2:G" & lrow(7))
ReDim arrAllData(1 To UBound(arrColOne, 1), 2) As Variant
For i = 1 To UBound(arrColOne, 1)
arrAllData(i, 0) = arrColOne(i, 1)
arrAllData(i, 1) = arrColTwo(i, 1)
arrAllData(i, 2) = arrColThree(i, 1)
Next i
End Sub
Public Function lrow(colNum As Integer) As Long
lrow = Cells(Rows.Count, colNum).End(xlUp).Row
End Function
The above will require all 3 columns to be the same length (otherwise populating the last array will not work); this is due to the fourth array being redimensioned to contain the number of elements contained in the first array.
Testing with 250,000 rows of data, the fourth array populated in 0.43 seconds.
How lenient are you with the array you get in return? I can get you a Array(col)(row)-style array, without having to loop to get it, if that works. Note that's not Array(col, row), by the way. It's a single-dimensional array of columns, with each element containing a single-dimensional array of row values. If you're okay with that, you can do this:
Dim a(1 To 3)
a(1) = WorksheetFunction.Index(WorksheetFunction.Transpose(Range("AA2:AA10")), 1, 0)
a(2) = WorksheetFunction.Index(WorksheetFunction.Transpose(Range("K2:K10" )), 1, 0)
a(3) = WorksheetFunction.Index(WorksheetFunction.Transpose(Range("L2:L10" )), 1, 0)
Then you could access your array items like so:
Debug.Print UBound(a) ' Number of columns (3)
Debug.Print UBound(a(1)) ' Number of rows in column 1
Debug.Print a(1)(3) ' Value of column 1 (AA), row 3
The Index() function can return a 1D array but only in the rows direction. So, you need to combine it with Transpose() to return a 1D column array. That's all the code above is doing.
What about an array of arrays?
Sub NoLoop()
Dim R1 As Range, R2 As Range, R3 As Range
Dim Arr1() As Variant, Arr2() As Variant, Arr3() As Variant
Dim LR As Long
LR1 = Cells(Rows.Count, "AA").End(xlUp).Row
LR2 = Cells(Rows.Count, "K").End(xlUp).Row
LR3 = Cells(Rows.Count, "L").End(xlUp).Row
Set R1 = Range(Cells(1, "AA"), Cells(LR1, "AA"))
Set R2 = Range(Cells(1, "K"), Cells(LR2, "K"))
Set R3 = Range(Cells(1, "L"), Cells(LR3, "L"))
Arr1 = R1.Value
Arr2 = R2.Value
Arr3 = R3.Value
ArrArr = Array(Arr1, Arr2, Arr3)
End Sub
With this you can call your values using:
MyVal = ArrArr(0)(1,1)
MyVal = ArrArr(0)(2,1)
MyVal = ArrArr(1)(1,1)
Where the first number is for the array (starts from 0 and ends with 2) and the second number is for row/cell of the range used to fill array.
The third number is always 1 (because adding a range to an array returns a bidimensional array)
With this code you can also have different dimensions for each column so to save memory.
I'm trying to compare two 2d arrays in VBA Excel.
Source:
1 2 3 4
4 5 6 2
3 3 4 4
Target:
4 5 3 2
1 2 3 4
3 7 7 5
Given the above two 2-d arrays which I will call source and target I want to compare each row from source with entire target and check if it exists in target. For
Example row 1 from source (1 2 3 4) would be considered a match as it would found in target (at row 2). So I need to compare each row in target for a given row from source. If row in source does not exist in target then I will need to make note of this some how in order to mark as not existing in target.
Something on the lines of (not actual code just idea):
For i to ubound(srcArray)
isFound = False
For j To ubound(trgArray)
If srcArray(i) = trgArray(j) Then
isFound = True
If Not isFound Then
//make note of some sort
I know approach worked ok for single dim. array. But trying to do this for 2d arrays in some sort of loop in VB or other method. Not too familiar with VB in Excel. I would also like to look at each row as entire array if possible rather than comparing each element for each array individually.
Here is an example of how to loop and compare the elements of a 2D array:
Sub ArrayCompare()
Dim MyArr1 As Variant, MyArr2 As Variant, X as long, Y as long
MyArr1 = [{1,2,3,4;4,5,6,2;3,3,4,4}]: MyArr2 = [{4,5,3,2;1,2,3,4;3,7,7,5}]
For X = LBound(MyArr1) To UBound(MyArr1)
For Y = LBound(MyArr1, 1) To UBound(MyArr1, 1)
If MyArr1(X, Y) = MyArr2(X, Y) Then MsgBox X & ":" & Y & ":" & MyArr1(X, Y)
Next
Next
End Sub
Here is my updated code to compare each row as a string (Thanks #Tim Williams :)):
Sub ArrayCompare()
Dim MyArr1 As Variant, MyArr2 As Variant, X As Long, Y As Long
MyArr1 = [{1,2,3,4;4,5,6,2;3,3,4,4}]: MyArr2 = [{4,5,3,2;1,2,3,4;3,7,7,5}]
For X = LBound(MyArr1) To UBound(MyArr1)
For Y = LBound(MyArr2) To UBound(MyArr2)
If Join(Application.Transpose(Application.Transpose(Application.Index(MyArr1, X, 0))), "|") = Join(Application.Transpose(Application.Transpose(Application.Index(MyArr2, Y, 0))), "|") Then MsgBox "Found a match at MyArr1 index:" & X & " and MyArr2 index:" & Y
Next
Next
End Sub
If you really want to avoid loops then you use this approach to extract a single "row" out of your 2-d array for comparison purposes, but it might be faster to loop.
Sub Tester()
Dim arr, rw
arr = Range("A1:J10").Value 'get 2-d array from worksheet
'get a 1-d array "row" out of the 2-d array
rw = Application.Transpose( _
Application.Transpose(Application.Index(arr, 1, 0)))
'then you can (eg) create a string for comparison purposes
Debug.Print Join(rw, Chr(0))
End Sub
I'm using VB6 and I need to do a ReDim Preserve to a Multi-Dimensional Array:
Dim n, m As Integer
n = 1
m = 0
Dim arrCity() As String
ReDim arrCity(n, m)
n = n + 1
m = m + 1
ReDim Preserve arrCity(n, m)
Whenever I do it as I have written it, I get the following error:
runtime error 9: subscript out of range
Because I can only change the last array dimension, well in my task I have to change the whole array (2 dimensions in my example) !
Is there any workaround or another solution for this?
As you correctly point out, one can ReDim Preserve only the last dimension of an array (ReDim Statement on MSDN):
If you use the Preserve keyword, you can resize only the last array
dimension and you can't change the number of dimensions at all. For
example, if your array has only one dimension, you can resize that
dimension because it is the last and only dimension. However, if your
array has two or more dimensions, you can change the size of only the
last dimension and still preserve the contents of the array
Hence, the first issue to decide is whether 2-dimensional array is the best data structure for the job. Maybe, 1-dimensional array is a better fit as you need to do ReDim Preserve?
Another way is to use jagged array as per Pieter Geerkens's suggestion. There is no direct support for jagged arrays in VB6. One way to code "array of arrays" in VB6 is to declare an array of Variant and make each element an array of desired type (String in your case). Demo code is below.
Yet another option is to implement Preserve part on your own. For that you'll need to create a copy of data to be preserved and then fill redimensioned array with it.
Option Explicit
Public Sub TestMatrixResize()
Const MAX_D1 As Long = 2
Const MAX_D2 As Long = 3
Dim arr() As Variant
InitMatrix arr, MAX_D1, MAX_D2
PrintMatrix "Original array:", arr
ResizeMatrix arr, MAX_D1 + 1, MAX_D2 + 1
PrintMatrix "Resized array:", arr
End Sub
Private Sub InitMatrix(a() As Variant, n As Long, m As Long)
Dim i As Long, j As Long
Dim StringArray() As String
ReDim a(n)
For i = 0 To n
ReDim StringArray(m)
For j = 0 To m
StringArray(j) = i * (m + 1) + j
Next j
a(i) = StringArray
Next i
End Sub
Private Sub PrintMatrix(heading As String, a() As Variant)
Dim i As Long, j As Long
Dim s As String
Debug.Print heading
For i = 0 To UBound(a)
s = ""
For j = 0 To UBound(a(i))
s = s & a(i)(j) & "; "
Next j
Debug.Print s
Next i
End Sub
Private Sub ResizeMatrix(a() As Variant, n As Long, m As Long)
Dim i As Long
Dim StringArray() As String
ReDim Preserve a(n)
For i = 0 To n - 1
StringArray = a(i)
ReDim Preserve StringArray(m)
a(i) = StringArray
Next i
ReDim StringArray(m)
a(n) = StringArray
End Sub
Since VB6 is very similar to VBA, I think I might have a solution which does not require this much code to ReDim a 2-dimensional array - using Transpose, if you are working in Excel.
The solution (Excel VBA):
Dim n, m As Integer
n = 2
m = 1
Dim arrCity() As Variant
ReDim arrCity(1 To n, 1 To m)
m = m + 1
ReDim Preserve arrCity(1 To n, 1 To m)
arrCity = Application.Transpose(arrCity)
n = n + 1
ReDim Preserve arrCity(1 To m, 1 To n)
arrCity = Application.Transpose(arrCity)
What is different from OP's question: the lower bound of arrCity array is not 0, but 1. This is in order to let Application.Transpose do it's job.
Note that Transpose is a method of the Excel Application object (which in actuality is a shortcut to Application.WorksheetFunction.Transpose). And in VBA, one must take care when using Transpose as it has two significant limitations: If the array has more than 65536 elements, it will fail. If ANY element's length exceed 256 characters, it will fail. If neither of these is an issue, then Transpose will nicely convert the rank of an array form 1D to 2D or vice-versa.
Unfortunately there is nothing like 'Transpose' build into VB6.
In regards to this:
"in my task I have to change the whole array (2 dimensions"
Just use a "jagged" array (ie an array of arrays of values). Then you can change the dimensions as you wish. You can have a 1-D array of variants, and the variants can contain arrays.
A bit more work perhaps, but a solution.
I haven't tested every single one of these answers but you don't need to use complicated functions to accomplish this. It's so much easier than that! My code below will work in any office VBA application (Word, Access, Excel, Outlook, etc.) and is very simple. Hope this helps:
''Dimension 2 Arrays
Dim InnerArray(1 To 3) As Variant ''The inner is for storing each column value of the current row
Dim OuterArray() As Variant ''The outer is for storing each row in
Dim i As Byte
i = 1
Do While i <= 5
''Enlarging our outer array to store a/another row
ReDim Preserve OuterArray(1 To i)
''Loading the current row column data in
InnerArray(1) = "My First Column in Row " & i
InnerArray(2) = "My Second Column in Row " & i
InnerArray(3) = "My Third Column in Row " & i
''Loading the entire row into our array
OuterArray(i) = InnerArray
i = i + 1
Loop
''Example print out of the array to the Intermediate Window
Debug.Print OuterArray(1)(1)
Debug.Print OuterArray(1)(2)
Debug.Print OuterArray(2)(1)
Debug.Print OuterArray(2)(2)
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 long as there is only one dimension that needs to be redimmed-preserved the approach would still work: just put that dimension last.
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?
(Posted earlier on similar question regarding two dimensions, extended answer here for more dimensions)
You can use a user defined type containing an array of strings which will be the inner array. Then you can use an array of this user defined type as your outer array.
Have a look at the following test project:
'1 form with:
' command button: name=Command1
' command button: name=Command2
Option Explicit
Private Type MyArray
strInner() As String
End Type
Private mudtOuter() As MyArray
Private Sub Command1_Click()
'change the dimensens of the outer array, and fill the extra elements with "1"
Dim intOuter As Integer
Dim intInner As Integer
Dim intOldOuter As Integer
intOldOuter = UBound(mudtOuter)
ReDim Preserve mudtOuter(intOldOuter + 2) As MyArray
For intOuter = intOldOuter + 1 To UBound(mudtOuter)
ReDim mudtOuter(intOuter).strInner(intOuter) As String
For intInner = 0 To UBound(mudtOuter(intOuter).strInner)
mudtOuter(intOuter).strInner(intInner) = "1"
Next intInner
Next intOuter
End Sub
Private Sub Command2_Click()
'change the dimensions of the middle inner array, and fill the extra elements with "2"
Dim intOuter As Integer
Dim intInner As Integer
Dim intOldInner As Integer
intOuter = UBound(mudtOuter) / 2
intOldInner = UBound(mudtOuter(intOuter).strInner)
ReDim Preserve mudtOuter(intOuter).strInner(intOldInner + 5) As String
For intInner = intOldInner + 1 To UBound(mudtOuter(intOuter).strInner)
mudtOuter(intOuter).strInner(intInner) = "2"
Next intInner
End Sub
Private Sub Form_Click()
'clear the form and print the outer,inner arrays
Dim intOuter As Integer
Dim intInner As Integer
Cls
For intOuter = 0 To UBound(mudtOuter)
For intInner = 0 To UBound(mudtOuter(intOuter).strInner)
Print CStr(intOuter) & "," & CStr(intInner) & " = " & mudtOuter(intOuter).strInner(intInner)
Next intInner
Print "" 'add an empty line between the outer array elements
Next intOuter
End Sub
Private Sub Form_Load()
'init the arrays
Dim intOuter As Integer
Dim intInner As Integer
ReDim mudtOuter(5) As MyArray
For intOuter = 0 To UBound(mudtOuter)
ReDim mudtOuter(intOuter).strInner(intOuter) As String
For intInner = 0 To UBound(mudtOuter(intOuter).strInner)
mudtOuter(intOuter).strInner(intInner) = CStr((intOuter + 1) * (intInner + 1))
Next intInner
Next intOuter
WindowState = vbMaximized
End Sub
Run the project, and click on the form to display the contents of the arrays.
Click on Command1 to enlarge the outer array, and click on the form again to show the results.
Click on Command2 to enlarge an inner array, and click on the form again to show the results.
Be careful though: when you redim the outer array, you also have to redim the inner arrays for all the new elements of the outer array
I stumbled across this question while hitting this road block myself. I ended up writing a piece of code real quick to handle this ReDim Preserve on a new sized array (first or last dimension). Maybe it will help others who face the same issue.
So for the usage, lets say you have your array originally set as MyArray(3,5), and you want to make the dimensions (first too!) larger, lets just say to MyArray(10,20). You would be used to doing something like this right?
ReDim Preserve MyArray(10,20) '<-- Returns Error
But unfortunately that returns an error because you tried to change the size of the first dimension. So with my function, you would just do something like this instead:
MyArray = ReDimPreserve(MyArray,10,20)
Now the array is larger, and the data is preserved. Your ReDim Preserve for a Multi-Dimension array is complete. :)
And last but not least, the miraculous function: ReDimPreserve()
'redim preserve both dimensions for a multidimension array *ONLY
Public Function ReDimPreserve(aArrayToPreserve,nNewFirstUBound,nNewLastUBound)
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
I wrote this in like 20 minutes, so there's no guarantees. But if you would like to use or extend it, feel free. I would've thought that someone would've had some code like this up here already, well apparently not. So here ya go fellow gearheads.
This is more compact and respect the intial first position in array and just use the inital bound to add old value.
Public Sub ReDimPreserve(ByRef arr, ByVal size1 As Long, ByVal size2 As Long)
Dim arr2 As Variant
Dim x As Long, y As Long
'Check if it's an array first
If Not IsArray(arr) Then Exit Sub
'create new array with initial start
ReDim arr2(LBound(arr, 1) To size1, LBound(arr, 2) To size2)
'loop through first
For x = LBound(arr, 1) To UBound(arr, 1)
For y = LBound(arr, 2) To UBound(arr, 2)
'if its in range, then append to new array the same way
arr2(x, y) = arr(x, y)
Next
Next
'return byref
arr = arr2
End Sub
I call this sub with this line to resize the first dimension
ReDimPreserve arr2, UBound(arr2, 1) + 1, UBound(arr2, 2)
You can add an other test to verify if the initial size is not upper than new array. In my case it's not necessary
Easiest way to do this in VBA is to create a function that takes in an array, your new amount of rows, and new amount of columns.
Run the below function to copy in all of the old data back to the array after it has been resized.
function dynamic_preserve(array1, num_rows, num_cols)
dim array2 as variant
array2 = array1
reDim array1(1 to num_rows, 1 to num_cols)
for i = lbound(array2, 1) to ubound(array2, 2)
for j = lbound(array2,2) to ubound(array2,2)
array1(i,j) = array2(i,j)
next j
next i
dynamic_preserve = array1
end function
Function Redim2d(ByRef Mtx As Variant, ByVal QtyColumnToAdd As Integer)
ReDim Preserve Mtx(LBound(Mtx, 1) To UBound(Mtx, 1), LBound(Mtx, 2) To UBound(Mtx, 2) + QtyColumnToAdd)
End Function
'Main Code
sub Main ()
Call Redim2d(MtxR8Strat, 1) 'Add one column
end sub
'OR
sub main2()
QtyColumnToAdd = 1 'Add one column
ReDim Preserve Mtx(LBound(Mtx, 1) To UBound(Mtx, 1), LBound(Mtx, 2) To UBound(Mtx, 2) + QtyColumnToAdd)
end sub
If you not want include other function like 'ReDimPreserve' could use temporal matrix for resizing. On based to your code:
Dim n As Integer, m As Integer, i as Long, j as Long
Dim arrTemporal() as Variant
n = 1
m = 0
Dim arrCity() As String
ReDim arrCity(n, m)
n = n + 1
m = m + 1
'VBA automatically adapts the size of the receiving matrix.
arrTemporal = arrCity
ReDim arrCity(n, m)
'Loop for assign values to arrCity
For i = 1 To UBound(arrTemporal , 1)
For j = 1 To UBound(arrTemporal , 2)
arrCity(i, j) = arrTemporal (i, j)
Next
Next
If you not declare of type VBA assume that is Variant.
Dim n as Integer, m As Integer