Creating an Array from a Range in VBA - arrays

I'm having a seemingly basic problem but can't find any resources addressing it.
Simply put, I just want to load the contents of a Range of cells (all one column) into an Array.
I am able to accomplish this by means of
DirArray = Array(Range("A1"), Range("A2"))
But for some reason, I cannot create the array when expressed this way:
DirArray = Array(Range("A1:A2"))
My real Range is much longer (and may vary in length), so I don't want to have to individually enumerate the cells this way. Can anyone tell me how to properly load a whole Range into an Array?
With the latter code:
MsgBox UBound(DirArray, 1)
And
MsgBox UBound(DirArray)
Return 0, whereas with the former they return 1.

Just define the variable as a variant, and make them equal:
Dim DirArray As Variant
DirArray = Range("a1:a5").Value
No need for the Array command.

If we do it just like this:
Dim myArr as Variant
myArr = Range("A1:A10")
the new array will be with two dimensions. Which is not always somehow comfortable to work with:
To get away of the two dimensions, when getting a single column to array, we may use the built-in Excel function “Transpose”. With it, the data becomes in one dimension:
If we have the data in a row, a single transpose will not do the job. We need to use the Transpose function twice:
Note: As you see from the screenshots, when generated this way, arrays start with 1, not with 0. Just be a bit careful.
Edit June.2021:
In newer versions of Excel, the function is: Application.WorksheetFunction.Transpose()

Using Value2 gives a performance benefit. As per Charles Williams blog
Range.Value2 works the same way as Range.Value, except that it does not check the cell format and convert to Date or Currency. And thats probably why its faster than .Value when retrieving numbers.
So
DirArray = [a1:a5].Value2
Bonus Reading
Range.Value: Returns or sets a Variant value that represents the value of the specified range.
Range.Value2: The only difference between this property and the Value property is that the Value2 property doesn't use the Currency and Date data types.

This function returns an array regardless of the size of the range.
Ranges will return an array unless the range is only 1 cell and then it returns a single value instead. This function will turn the single value into an array (1 based, the same as the array's returned by ranges)
This answer improves on previous answers as it will return an array from a range no matter what the size. It is also more efficient that other answers as it will return the array generated by the range if possible. Works with single dimension and multi-dimensional arrays
The function works by trying to find the upper bounds of the array. If that fails then it must be a single value so we'll create an array and assign the value to it.
Public Function RangeToArray(inputRange As Range) As Variant()
Dim size As Integer
Dim inputValue As Variant, outputArray() As Variant
' inputValue will either be an variant array for ranges with more than 1 cell
' or a single variant value for range will only 1 cell
inputValue = inputRange
On Error Resume Next
size = UBound(inputValue)
If Err.Number = 0 Then
RangeToArray = inputValue
Else
On Error GoTo 0
ReDim outputArray(1 To 1, 1 to 1)
outputArray(1,1) = inputValue
RangeToArray = outputArray
End If
On Error GoTo 0
End Function

In addition to solutions proposed, and in case you have a 1D range to 1D array, i prefer to process it through a function like below. The reason is simple: If for any reason your range is reduced to 1 element range, as far as i know the command Range().Value will not return a variant array but just a variant and you will not be able to assign a variant variable to a variant array (previously declared).
I had to convert a variable size range to a double array, and when the range was of 1 cell size, i was not able to use a construct like range().value so i proceed with a function like below.
Public Function Rng2Array(inputRange As Range) As Double()
Dim out() As Double
ReDim out(inputRange.Columns.Count - 1)
Dim cell As Range
Dim i As Long
For i = 0 To inputRange.Columns.Count - 1
out(i) = inputRange(1, i + 1) 'loop over a range "row"
Next
Rng2Array = out
End Function

I'm another vote for iterating through the cells in the range. Unless somebody has found a workaround, my experience trying to assign the range directly to a Variant has been that it works fine (albeit returning a 2-dimensional array when I really only need 1D) except if my range has multiple areas, like for example, when I want just the visible cells in a column of a filtered table, or if I have ctrl-selected different blocks of cells on a sheet.
Iterating through all the cells in the range with a for..each loop always produces the results I expect.
Public Function RangeToArray(ByRef myRange As Range)
Dim i As Long
Dim individualCell As Range
ReDim myArray(myRange.Count - 1)
For Each individualCell In myRange
myArray(i) = individualCell.Text ' or maybe .Value
i = i + 1
Next
RangeToArray = myArray
End Function
I wanted to add this as a comment to Paolo's answer since it's pretty similar but I am a newbie and don't have enough reputation, so here's another slightly different answer.

Adding to #Vityata 's answer, below is the function I use to convert a row / column vector in a 1D array:
Function convertVecToArr(ByVal rng As Range) As Variant
'convert two dimension array into a one dimension array
Dim arr() As Variant, slicedArr() As Variant
arr = rng.value 'arr = rng works too (https://bettersolutions.com/excel/cells-ranges/vba-working-with-arrays.htm)
If UBound(arr, 1) > UBound(arr, 2) Then
slicedArr = Application.WorksheetFunction.Transpose(arr)
Else
slicedArr = Application.WorksheetFunction.index(arr, 1, 0) 'If you set row_num or column_num to 0 (zero), Index returns the array of values for the entire column or row, respectively._
'To use values returned as an array, enter the Index function as an array formula in a horizontal range of cells for a row,_
'and in a vertical range of cells for a column.
'https://usefulgyaan.wordpress.com/2013/06/12/vba-trick-of-the-week-slicing-an-array-without-loop-application-index/
End If
convertVecToArr = slicedArr
End Function

Transpose is a great advice.
I have multiple arrays in my app. Some global, some local, some loaded from ranges and some created programatically.
I had numerous problems with dimensioning. Now, with transpose they are all one dimension.
I did have to modify code slightly, because one version runs on Excel 2003 and another (slower) on 2010.
Caution: You will have to Transpose the array again, when saving it to a range.

Using the shape of the Range
Another approach in creating a function for ArrayFromRange would be using the shape and size of the Range to determine how we should structure the array. This way we don't have to load the data into an intermediate array to determine the dimension.
For instance, if the target range is only one cell, then we know we want to return an array with the single value in it Array(target.value).
Below is the complete function that should deal with all cases. Note, this uses the same technique of using the Application.Transpose method to reshape the array.
' Helper function that returns an array from a range with the
' correct dimensions. This fixes the issue of single values
' not returning as an array, and when a 2 dimension array is returned
' when it only has 1 dimension of data.
'
' #author Robert Todar <robert#roberttodar.com>
Public Function ArrayFromRange(ByVal target As Range) As Variant
Select Case True
' Single cell
Case target.Cells.Count = 1
ArrayFromRange = Array(target.Value)
' Single Row
Case target.Rows.Count = 1
ArrayFromRange = Application.Transpose( _
Application.Transpose(target.Value) _
)
' Single Column
Case target.Columns.Count = 1
ArrayFromRange = Application.Transpose(target.Value)
' Multi dimension array
Case Else
ArrayFromRange = target.Value
End Select
End Function
Testing the ArrayFromRange function
As a bonus, here are the tests that I ran to check that this function works.
' #requires {function} ArrayDimensionLength
' #requires {function} ArrayCount
Private Sub testArrayFromRange()
' Setup a new workbook/worksheet for
' adding testing data
Dim testWorkbook As Workbook
Set testWorkbook = Workbooks.Add
Dim ws As Worksheet
Set ws = testWorkbook.Worksheets(1)
' Add sample data for testing.
ws.Range("A1:A2") = Application.Transpose(Array("A1", "A2"))
ws.Range("B1:B2") = Application.Transpose(Array("B1", "B2"))
' This section will run all the tests.
Dim x As Variant
' Single cell
x = ArrayFromRange(ws.Range("A1"))
Debug.Assert ArrayDimensionLength(x) = 1
Debug.Assert ArrayCount(x) = 1
' Single Row
x = ArrayFromRange(ws.Range("A1:B1"))
Debug.Assert ArrayDimensionLength(x) = 1
Debug.Assert ArrayCount(x) = 2
' Single Column
x = ArrayFromRange(ws.Range("A1:A2"))
Debug.Assert ArrayDimensionLength(x) = 1
Debug.Assert ArrayCount(x) = 2
' Multi Column
x = ArrayFromRange(ws.Range("A1:B2"))
Debug.Assert ArrayDimensionLength(x) = 2
Debug.Assert ArrayCount(x) = 4
' Cleanup testing environment
testWorkbook.Close False
' Print result
Debug.Print "testArrayFromRange: PASS"
End Sub
Helper functions for the tests
In my tests I used two helper functions: ArrayCount, and ArrayDimensionLength. These are listed below for reference.
' Returns the length of the dimension of an array
'
' #author Robert Todar <robert#roberttodar.com>
Public Function ArrayDimensionLength(sourceArray As Variant) As Integer
On Error GoTo catch
Do
Dim currentDimension As Long
currentDimension = currentDimension + 1
' `test` is used to see when the
' Ubound throws an error. It is unused
' on purpose.
Dim test As Long
test = UBound(sourceArray, currentDimension)
Loop
catch:
' Need to subtract one because the last
' one errored out.
ArrayDimensionLength = currentDimension - 1
End Function
' Get count of elements in an array regardless of
' the option base. This Looks purely at the size
' of the array, not the contents within them such as
' empty elements.
'
' #author Robert Todar <robert#roberttodar.com>
' #requires {function} ArrayDimensionLength
Public Function ArrayCount(ByVal sourceArray As Variant) As Long
Dim dimensions As Long
dimensions = ArrayDimensionLength(sourceArray)
Select Case dimensions
Case 0
ArrayCount = 0
Case 1
ArrayCount = (UBound(sourceArray, 1) - LBound(sourceArray, 1)) + 1
Case Else
' Need to set arrayCount to 1 otherwise the
' loop will keep multiplying by zero for each
' iteration
ArrayCount = 1
Dim dimension As Long
For dimension = 1 To dimensions
ArrayCount = ArrayCount * _
((UBound(sourceArray, dimension) - LBound(sourceArray, dimension)) + 1)
Next
End Select
End Function

Related

Splitting array values into the correct column

Need some help on sorting the values into the correct column.
I can't seem to figure out how I would return the array values to the proper column in the table.
For the output into column B "Pipe DN" it should return the first split text from the values in "Line number", and for the "Service" column F it should return the 2nd split text from "Line number".
How would I accomplish this? -
If for "Pipe DN" I use Range("B19", Range("B19").Offset(Dimension1 - 1, 1)).Value = StrArray, it will return me the correct values, but the "Service" code is not written on the correct column.
Sub SplitLinesIntoArray()
Dim LineNumber() As Variant
Dim StrArray() As Variant
Dim Dimension1 As Long, Counter As Long
LineNumber = Range("J19", Range("J19").End(xlDown))
Dimension1 = UBound(LineNumber, 1)
ReDim StrArray(1 To Dimension1, 1 To 2)
For Counter = 1 To Dimension1
'Pipe DN
StrArray(Counter, 1) = Split(LineNumber(Counter, 1), "-")(0)
Range("B19", Range("B19").Offset(Dimension1 - 1, 0)).Value = StrArray
'Service Code
StrArray(Counter, 2) = Split(LineNumber(Counter, 1), "-")(1)
Range("F19", Range("F19").Offset(Dimension1 - 1, 0)).Value = StrArray(Counter, 2)
Next Counter
'Range("B19", Range("B19").Offset(Dimension1 - 1, 1)).Value = StrArray
Erase LineNumber
Erase StrArray
End Sub
Basically you start well by analyzing a 2-dim datafield array and assigning resulting string manipulations (Split()) to it.
Results seem to (1) output correctly as for the first array "column" ("Pipe DN", starting in cell B19),
whereas (2) the second column ("Service", F19) repeats the result of the very last split action for each array "row".
This impression has to be qualified:
ad 1) You are doing unnecessary extra work by assigning the entire StrArray to the entire "Pipe DN" column,
repeating this action with each single row iteration. (Note that the StrArray gets only completely filled with the last loop).
ad 2) Basically you assign again with each iteration, but this time you get only the latest split result and fill the entire "Service" column
with the latest result assigned to StrArray(Counter,2). Eventually all items show the last split result instead of the individual LineNumber splittings.
See this abbreviated example for three example items only to understand what is happening
(this SnapShot shows the table results when code is stopped after the 2nd iteration (i.e. after Counter=2):
Immediate help
Sticking to your initial code, I'd omit
Range("B19", Range("B19").Offset(Dimension1 - 1, 0)).Value = StrArray as well as
Range("F19", Range("F19").Offset(Dimension1 - 1, 0)).Value = StrArray(Counter, 2)
within the For..Next loop, but add the following two code lines thereafter:
Range("B19", Range("B19").Offset(Dimension1 - 1, 0)).Value = Application.Index(StrArray, 0, 1)
Range("F19", Range("F19").Offset(Dimension1 - 1, 0)).Value = Application.Index(StrArray, 0, 2)
in order to slice the StrArray into columns and write each column separately to your cell target.
Further note:
Fully qualify your range references to prevent possibly unwanted results as Excel would take the currently active sheet if not referenced explicitly ... and this need not be the targeted one :-;
Using VBA, it's not necessary in standard office situations to clear (Erase) at the end of a procedure to free memory.
Possible alternative avoiding array slicing
You might profit from the the following code, which
fully qualifies your range references (note: unqualified refs invite Excel to take the currently active sheet without request),
uses a jagged array (aka as Array of Arrays) to avoid (multiple) column slicing (as needed in OP)
demonstrates the use of Private Constants on module top (used here for enumerating the sub-arrays within the jagged array
demonstrates a help procedure to provide for a correcty dimensioned jagged array:
Example code
Option Explicit ' declaration head of code module (forching variable declarations)
Private Const LineNum As Long = 0 ' enumerate sub-arrays within jagged array
Private Const Pipe As Long = 1
Private Const Service As Long = 2
Sub SplitLinesIntoJaggedArray()
'I. Set Worksheet object to memory ' fully qualify any range references!
Dim ws As Worksheet ' declare ws as of worksheet object type
Set ws = Tabelle1 ' << use the project's sheet Code(Name)
'set ws = ThisWorkbook.Worksheets("Sheet1") ' or: via a sheet's tabular name (needn't be the same)
With ws ' With .. End With structure, note the following "."-prefixes
'II.Definitions
'a) assign target start cell addresses to array tgt
Dim tgt As Variant
tgt = Split("J19,B19,F19", ",") ' split requires "Dim tgt" without brackets to avoid Error 13
'b) define source range object and set to memory
' Note: tgt(LinNum) equalling tgt(0) equalling "J19"
Dim src As Range
Set src = .Range(tgt(LineNum), .Range(tgt(0)).End(xlDown)) ' showing both enumerations only for demo:-)
Dim CountOfRows As Long: CountOfRows = src.Rows.Count ' count rows in source range
'c) provide for a correctly dimensioned jagged array to hold all 2-dim data arrays (three columns)
Dim JaggedArray() As Variant
BuildJagged JaggedArray, CountOfRows ' << call help procedure BuildJaggedArray
'III.Assign column data to JaggedArray
'a) assign LineNum column as 2-dim datafield to JaggedArray(LineNum)
JaggedArray(LineNum) = src.Value
'b) assign LineNum splits to JaggedArray(Pipe) and JaggedArray(Service)
Dim Counter As Long
For Counter = 1 To CountOfRows
'1. Pipe DN
JaggedArray(Pipe)(Counter, 1) = Split(JaggedArray(LineNum)(Counter, 1), "-")(0)
'2. Service Code
JaggedArray(Service)(Counter, 1) = Split(JaggedArray(LineNum)(Counter, 1), "-")(1)
Next Counter
'IV.Write result columns of jagged array to target addresses
' Note: tgt(Pipe)=tgt(1)="B19", tgt(Service)=tgt(2)="F19"
Dim elem As Long
For elem = Pipe To Service
.Range(tgt(elem)).Resize(CountOfRows, 1) = JaggedArray(elem)
Next
End With
End Sub
*Help procedure BuildJagged
Note that the first procedure argument passes the jagged array By Reference (=default, if not explicitly passed ByVal).
This means that any further actions within the help procedure have an immediate effect on the original array.
Sub BuildJagged(ByRef JaggedArray, ByVal CountOfRows As Long)
'Purpose: provide for correct dimensions of the jagged array passed By Reference
ReDim JaggedArray(LineNum To Service) ' include LineNum as data base (gets dimmed later)
Dim tmp() As Variant
ReDim tmp(1 To CountOfRows, 1 To 1)
Dim i As Long
For i = Pipe To Service ' suffices here to start from 1=Pipe to 2=Service
JaggedArray(i) = tmp
Next i
End Sub
Further link
Error in finding last used cell in Excel VBA

Problem working with variant data type w/vba

I am trying to learn to use variant data type but facing issues.
Public Function z_score(sections As Range, marks As Range) As Variant
Dim n As Integer
Dim score() As Variant 'marks range has a few empty cells and error cells as well
'hence using variant data type
n = UBound(sections.Value)
ReDim score(1 To n, 1 To 2)
score = marks.Value 'assigning marks range values to first column of score
For i = 1 To n 'adding second column with integer index for calling later
score(i, 2) = i
Next i
z_score = score
End Function
I am getting value error instead of nx2 matrix as output.
Can you please help how to resolve the error.
Any help is much appreciated, thanks..
There are a few areas that could cause this code to fail, I'm afraid:
If the passed in range is only 1 cell, the assignment to an array will throw an error.
VBA doesn't have a method for copying or cloning arrays, so your code score = marks.Value isn't doing what your comments are saying,
The sections parameter doesn't appear to be doing anything. You are sizing the array against it, but then iterating the marks array to assign values.
I'm not sure what you want to do with the function, but if it is a UDF called from a worksheet, it would need to be a formula array.
You could adjust your code as follows to have something a little more robust:
Public Function z_score(marks As Range) As Variant
Dim scoreArray() As Variant, marksArray() As Variant
Dim i As Long
marksArray = RangeValueToArray(marks)
ReDim scoreArray(1 To UBound(marksArray, 1), 1 To 2)
For i = 1 To UBound(marksArray, 1)
scoreArray(i, 1) = i
scoreArray(i, 2) = marksArray(i, 1)
Next
z_score = scoreArray
End Function
Private Function RangeValueToArray(rng As Range) As Variant
Dim v() As Variant
If rng.Cells.Count = 1 Then
ReDim v(1 To 1, 1 To 1)
v(1, 1) = rng.Value2
RangeValueToArray = v
Exit Function
End If
v = rng.Value2
RangeValueToArray = v
End Function
I think I figured out the problem. Assigning values of range to array works but makes the assigned array two dimensional array but with only 1 column if given range has only one column or row! So moving the redim with preserve to after assignment line worked for my purpose.
But if one wants to assign values to a column other than first in a 2D array (albeit with 1 column), only solution I am aware of at this point is to do iteration the way Ambie suggested.
Public Function z_score(sections As Range, marks As Range) As Variant
Dim score() As Variant 'marks range has a few empty cells and error cells as well
'hence using variant data type
Dim n As Integer
n = UBound(sections.Value)
score = marks.Value 'assigning marks range values to first column of score
ReDim Preserve score(1 To n, 1 To 2)
For i = 1 To n 'adding second column with integer index for calling later
score(i, 2) = i
Next i
z_score = score
End Function

Excel array Populated with non blank values of listobject column range

I have a column of a list object with some non empty values at the beginning. Just assume the first 15 values are not blank.
I know it is possible to pass the values of a range to an array like this:
Dim mylistObject As ListObject
Set mylistObject = ThisWorkbook.Sheets("training").ListObjects(1)
Dim theArray() As Variant
theArray = mylistObject.listcolumn(1).DataBodyRange.value
The question is how can I pass only the non blank values.
I know how to do it with loops but the key point here is speed, if the listobject has hundreds of rows and the operation is done tens of times it takes too long.
I also know that it might be possible to calculate the number of non blank cells and redim the array accordingly and loop through values. still not elegant.
Any idea? there should be a way to tell in VBA language
mylistObject.listcolumn(1).DataBodyRange.value
' but not all the range but the non empty ones.
Thanks a lot
Using the possibilities of the Application.Index function
Demonstrate an easy approach to create and transform the listbox'es column data Array:
Get all data of first column (including blanks) as already shown in the original post (BTW the correct syntax in the array assignment is theArray = mylistObject.ListColumns(1).DataBodyRange.Value with a final "s" in .ListColumns)
Eliminate blank row numbers using the advanced features of the Application.Index function and a subordinated function call (getNonBlankRowNums())
Basic transformation syntax by one code line:
newArray = Application.Index(oldArray, Application.Transpose(RowArray), ColumnArray)
where RowArray / ColumnArray stands for an array of (remaining) row or column numbers.
Related link: Some peculiarities of the the Application.Index function
Sub NonBlanks()
' Note: encourageing to reference a sheet via CodeName instead of Thisworkbook.Worksheets("training")
' i.e. change the (Name) property in the VBE properties tool window (F4) for the referenced worksheet
' (c.f. https://stackoverflow.com/questions/58507542/set-up-variable-to-refer-to-sheet/58508735#58508735)
Dim mylistObject As ListObject
Set mylistObject = training.ListObjects(1)
' [1] Get data of first column (including blanks)
Dim theArray As Variant
theArray = mylistObject.ListColumns(1).DataBodyRange.Value ' LISTCOLUMNS with final S!!
' [2] eliminate blank row numbers
theArray = Application.Index(theArray, Application.Transpose(getNonBlankRowNums(theArray)), Array(1))
End Sub
Function getNonBlankRowNums(arr, Optional ByVal col = 1) As Variant()
' Purpose: return 1-dim array with remaining non-blank row numbers
Dim i&, ii&, tmp
ReDim tmp(1 To UBound(arr))
For i = 1 To UBound(arr)
If arr(i, col) <> vbNullString Then ' check for non-blanks
ii = ii + 1 ' increment temporary items counter
tmp(ii) = i ' enter row number
End If
Next i
ReDim Preserve tmp(1 To ii) ' redim to final size preserving existing items
' return function value (variant array)
getNonBlankRowNums = tmp
End Function

Create dynamically sized array to store row counter

The function below finds the first result.
There could be duplicate rows with matching values that meet my if statements. How would I create an array to store the row numbers the search function found so that I can process the data later.
How would I create the array size based on the number of results found in the for loop?
I am assuming that the for loop counter will have some sort of role to play in this. Let's say the for loop found 2 matches in row numbers 56 and 98 matching my if statements:
array_example(counter, 0) = 56
array_example(counter, 0) = 98
The stored values would be:
array_example(1, 0) = 56
array_example(2, 0) = 98
Private Sub Complex_Search(col1, cval1, col2, cval2)
'MsgBox (col1 & " " & col2)
'MsgBox (cval1 & " " & cval2)
Dim i
Dim lRow
Dim Counter
lRow = Cells(Rows.Count, 1).End(xlUp).row
Counter = 0
With Sheets("Office Spaces")
For i = 2 To lRow
If LCase(.Cells(i, col1).Value) = LCase(cval1) And LCase(.Cells(i, col2).Value) = LCase(cval2) Then
row = i
Counter = Counter + 1
End If
Next i
End With
If row = "" Then
MsgBox ("Search complete. 0 results found")
Else
GetRowData (row)
UserForm1.resmax.Value = 1
End If
End Sub
It's worth noting that you haven't even initialized row, and have just let vba implicitly declare it as a variant type for you. To avoid common problems that arise from typos, include Option Explicit at the top of your code and Dim every variable with the type beside it. For example: Dim i as long. Dim i will work, but it will declare it as a variant type
To initialize an array in VBA you use Dim row() as variant. From there you can re-dimension its size using Redim row(LboundX to UboundX) but this will reset all the stored values to zero. To get around this use Redim Preserve row(LBoundX to UBound X).
If you wish to use a 2D array, add a comma and then put the bounds for the next dimension Redim Preserve row(LBoundX to UBound X, LboundY to UBoundY)
At the top of your code I would include
Dim row() as Variant
Redim Preserve row(1 to 1)
Then within the loop I would change row = i to
row(Ubound(row)) = i
Redim Preserve row(1 to Ubound(row) +1)
Now that you have an array though, the check you do below will no longer work and will likely throw an error because you there's no specified index. Instead I suggest changing it from If row = "" Then to If Counter = 0 Then.
I'm not sure what the intention is with GetRowData(row) but you can just access each row number via row(i). It is worth noting however, that the row array will have Counter +1 number of items, but the last one will be blank. You could get around this by adding in an if statement within the already existing one that would look something like this:
If Counter = 0 Then
row(1) = i
Else
ReDim Preserve row(1 To UBound(row) + 1)
row(UBound(row)) = i
End If
Counter = Counter + 1
By implementing this change, row should have exactly Counter number of items that all have a non-empty value
I don't really suggest making a column array because it becomes more cumbersome to change the array size. Redim preserve or not only allows you to change the last dimension in the array, so to change the number of rows you would have to set the array equal to the transpose of itself, do the redim and then set it to the transpose of itself again. It's just needlessly messy. If you're pasting it to a sheet and need it to be in a column you could just transpose it at the end instead.

Add Strings to Dynamic Array VBA

Problem: I am comparing two columns of names. If a name from the primary column matches a name in the secondary column, then I would like to add the matching name to an array of strings.
Function 1: This boolean function should indicate whether there is a match:
Function Match(name As String, s As Worksheet, column As Integer) As Boolean
Dim i As Integer
i = 2
While s.Cells(i, column) <> ""
If s.Cells(i, column).Value = name Then
Match = True
End If
i = i + 1
Wend
Match = False
End Function
Function 2: This function should add the matching name to a dynamic array of strings. Here I am somewhat stuck as I am new to arrays- any suggestions?
Function AddToArray(ys) As String()
Dim a() As String
Dim size As Integer
Dim i As Integer
Dim sh As Worksheet
Dim rw As Range
size = 0
ReDim Preserve a(size)
For Each rw In sh.Rows
If Match(sh.Cells(rw.Row, 1), s, column) = True Then
??
size = size + 1
End Function
Here is one solution. I scrapped your Match function and replaced it with a Find function.
Option Explicit
Sub AddToArray()
Dim primaryColumn As Range, secondaryColumn As Range, matchedRange As Range
Dim i As Long, currentIndex As Long
Dim matchingNames As Variant
With ThisWorkbook.Worksheets("Sheet1")
Set primaryColumn = .Range("A1:A10")
Set secondaryColumn = .Range("B1:B10")
End With
'Size your array so no dynamic resizing is necessary
ReDim matchingNames(1 To primaryColumn.Rows.Count)
currentIndex = 1
'loop through your primary column
'add any values that match to the matchingNames array
For i = 1 To primaryColumn.Rows.Count
On Error Resume Next
Set matchedRange = secondaryColumn.Find(primaryColumn.Cells(i, 1).Value)
On Error GoTo 0
If Not matchedRange Is Nothing Then
matchingNames(currentIndex) = matchedRange.Value
currentIndex = currentIndex + 1
End If
Next i
'remove unused part of array
ReDim Preserve matchingNames(1 To currentIndex - 1)
'matchingNames array now contains just the values you want... use it how you need!
Debug.Print matchingNames(1)
Debug.Print matchingNames(2)
'...etc
End Sub
Extra comments
There is no need to create your own Match function because it already exists in VBA:
Application.Match()
WorksheetFunction.Match()
and as I mentioned above you can also achieve the same result with the Find function which is my preference here because I prefer the way you can check for no matches (other methods throw less convenient errors).
Finally, I also opted to restructure your code into one Sub rather than two Functions. You weren't returning anything with your AddToArray function which pretty much means by definition it should actually be a Sub
As I stated in a comment to the question, there are a couple of problems in your code before adding anything to the array that will prevent this from working, but assuming that this was caused by simplifying the code to ask the question, the following should work.
The specific question that you are asking, is how to populate the array while increasing its size when needed.
To do this, simply do this:
Instead of:
ReDim Preserve a(size)
For Each rw In sh.Rows
If Match(sh.Cells(rw.Row, 1), s, column) = True Then
Reorder this so that it is:
For Each rw In sh.Rows
If Match(sh.Cells(rw.Row, 1), s, column) = True Then
ReDim Preserve a(size) 'increase size of array
a(size) = sh.Cells(rw.Row,1) 'put value in array
size = size + 1 'create value for size of next array
End If
Next rw
....
This probably isn't the best way to accomplish this task, but this is what you were asking to do. First, increasing the array size EVERY time is going to waste a lot of time. It would be better to increase the array size every 10 or 100 matches instead of every time. I will leave this exercise to you. Then you could resize it at the end to the exact size you want.

Resources