I would like to add a value to the end of a VBA array. How can I do this? I was not able to find a simple example online. Here's some pseudocode showing what I would like to be able to do.
Public Function toArray(range As range) Dim arr() As Variant For Each a In range.Cells 'how to add dynamically the value to end and increase the array? arr(arr.count) = a.Value 'pseudo code Next
toArray= Join(arr, ",")
End Function 1 7 Answers
I solved the issue by using a Collection and copy it afterwards to an array.
Dim col As New Collection
For Each a In range.Cells col.Add a.Value ' dynamically add value to the end
Next
Dim arr() As Variant
arr = toArray(col) 'convert collection to an array
Function toArray(col As Collection) Dim arr() As Variant ReDim arr(0 To col.Count-1) As Variant For i = 1 To col.Count arr(i-1) = col(i) Next toArray = arr
End Function 1 Try this [EDITED]:
Dim arr() As Variant ' let brackets empty, not Dim arr(1) As Variant !
For Each a In range.Cells ' change / adjust the size of array ReDim Preserve arr(1 To UBound(arr) + 1) As Variant ' add value on the end of the array arr (UBound(arr)) = a.value
Next 8 This is how I do it, using a Variant (array) variable:
Dim a As Range
Dim arr As Variant 'Just a Variant variable (i.e. don't pre-define it as an array)
For Each a In Range.Cells If IsEmpty(arr) Then arr = Array(a.value) 'Make the Variant an array with a single element Else ReDim Preserve arr(UBound(arr) + 1) 'Add next array element arr(UBound(arr)) = a.value 'Assign the array element End If
NextOr, if you actually do need an array of Variants (to pass to a property like Shapes.Range, for example), then you can do it this way:
Dim a As Range
Dim arr() As Variant
ReDim arr(0 To 0) 'Allocate first element
For Each a In Range.Cells arr(UBound(arr)) = a.value 'Assign the array element ReDim Preserve arr(UBound(arr) + 1) 'Allocate next element
Next
ReDim Preserve arr(LBound(arr) To UBound(arr) - 1) 'Deallocate the last, unused element 1 If your range is a single vector, and, if in a column, the number of rows is less than 16,384, you can use the following code:
Option Explicit
Public Function toArray(RNG As Range) Dim arr As Variant arr = RNG With WorksheetFunction If UBound(arr, 2) > 1 Then toArray = Join((.Index(arr, 1, 0)), ",") Else toArray = Join(.Transpose(.Index(arr, 0, 1)), ",") End If End With
End Function Thx. Doing the same with 2 functions if it can help other noobs like me :
Collection
Function toCollection(ByVal NamedRange As String) As Collection Dim i As Integer Dim col As New Collection Dim Myrange As Variant, aData As Variant Myrange = Range(NamedRange) For Each aData In Myrange col.Add aData '.Value Next Set toCollection = col Set col = Nothing
End Function1D Array :
Function toArray1D(MyCollection As Collection) ' See If MyCollection Is Nothing Then Debug.Print Chr(10) & Time & ": Collection Is Empty" Exit Function End If Dim myarr() As Variant Dim i As Integer ReDim myarr(1 To MyCollection.Count) As Variant For i = 1 To MyCollection.Count myarr(i) = MyCollection(i) Next i toArray1D = myarr
End FunctionUsage
Dim col As New Collection
Set col = toCollection(RangeName(0))
Dim arr() As Variant
arr = toArray1D(col)
Set col = Nothing The answer is in the accepted response in(without the ReDim problem):
In resume:
Dim aArray() As Single ' or whatever data type you wish to use
ReDim aArray(1 To 1) As Single
If strFirstName = "henry" Then aArray(UBound(aArray)) = 123.45 ReDim Preserve aArray(1 To UBound(aArray) + 1) As Single
End If 0 Dim arr() As Variant: ReDim Preserve arr(0) ' Create dynamic array
' Append to dynamic array function
Function AppendArray(arr() As Variant, var As Variant) As Variant ReDim Preserve arr(LBound(arr) To UBound(arr) + 1) ' Resize array, add index arr(UBound(arr) - 1) = var ' Append to array
End Function