2

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
Improve this question
2
  • 1
    First, when you call the Match function, in the AddToArray function, you are calling it with the parameter s but you have declared the worksheet as variable name sh, which you have not initialized to anything. You also are calling it with the parameter column which hasn't been declared and hasn't been initialized, so this statement won't work. Commented May 10, 2017 at 17:29
  • One more thing: The Match function won't work. As written, it will always return False because it will get through the While loop and then automatically get set to False. You need to put the Match=False statement at the BEGINNING of the function if you want to do it this way. Commented May 10, 2017 at 20:25

2 Answers 2

Reset to default
2

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

Improve this answer
Sign up to request clarification or add additional context in comments.

2 Comments

I agree that this is a much better solution to the OPs problem than the OPs original approach, but it would be better if you explained WHY you made all of these changes. For instance, you called out that you replaced their Match function with the default Find function without telling them why. It is likely obvious to you why you would do this, but it is likely not obvious to the OP, else they would have been able to solve the problem themselves already.
@OpiesDad. Thanks for the push in the right direction. I definitely didn't have enough comments with the code.
1

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.

Improve this answer

1 Comment

Good explanation!! Could be even better to execute a CountIf or other construct to determine the size in advance, and then use a single ReDim statement outside the loop, or to use a collection or dictionary (dictionary.Items() returns an array, for instance) :) Plenty of ways to skin this cat!

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.