Excel VBA Regex Function That Returns Multiple Matches Into A Single Cell

Question

I need help getting my Excel function to work. The goal is to run an in-cell function that extracts all pattern matches of a regex function from the input of another cell into one cell, not an array of cells.

I have tried this using an array which returns two matches in the function dialogue box preview but only outputs the first match in the cell. I have also tried using a collection but had no luck with that.

Here is my current code and a sample of text that would be used as the function's string input:

Function RegexMatches(strInput As String) As Variant

Dim rMatch As Match
Dim arrayMatches
Dim i As Long

arrayMatches = Array()

With New RegExp
    .Global = True
    .MultiLine = True
    .IgnoreCase = True
    .Pattern = "(Code)[\s][\d]{2,4}"
        For Each rMatch In .Execute(strInput)
        ReDim Preserve arrayMatches(i)
        arrayMatches(i) = rMatch.Value
        i = i + 1
    Next
End With

    RegexMatches = arrayMatches
End Function

Sample strInput from an Excel cell:

Code 123 some random text
goes here and continues to the next line
Code 4567 followed by more text
including new lines not just wrapped text


The desired output from this function would be both (2) matched values from the regex function into a single cell (eg "Code 123 Code 4567").

Any help is greatly appreciated!

Answer 1

Looks like you missed off the end of your function (as per Mat's Mug's comment)? Try this (which is as per Wiktor's comment).

Edit: amended in light of Mat's Mug's suggestion.

Function RegexMatches(strInput As String) As String

Dim rMatch As Object
Dim s As String
Dim arrayMatches()
Dim i As Long

With New RegExp
    .Global = True
    .MultiLine = True
    .IgnoreCase = True
    .Pattern = "(Code)[\s][\d]{2,4}"
    If .test(strInput) Then
        For Each rMatch In .Execute(strInput)
            ReDim Preserve arrayMatches(i)
            arrayMatches(i) = rMatch.Value
            i = i + 1
            's = s & " " & rMatch
        Next
    End If
End With

RegexMatches = Join(arrayMatches, " ")

End Function