UDF to concatenate values

Question

I am trying to build a user defined function using VBA for excel. That would concatenate a list of stores which has ax mark in that row.

   Store1 Store2 Store3    Concatenate
      x             x      Store1,Store3  
      x      x             tore1,Store2
      x                    Store1

I managed to write this vba code, but I am not sure this is the best approach. As I was tesing in on 1000 and more lines, it was quite slow. Maybe it is possible to optimise it?

firstStore you point where the first store starts (not the names, but the x marks, lastStore1 the last column. listofstores1 is the row where the store names are.

Function listofstores(firstStore As Range, lastStore1 As Range, listofstores1 As Range)
    Application.Volatile

    Dim offsetvalue As Integer

    offsetvalue = -(lastStore1.Row - listofstores1.Row)

    lastStore = lastStore1.Column
    Set initial = firstStore

    For i = 1 To lastStore
    If initial = "X" Or initial = "x" Then Store = initial.Offset(offsetvalue, 0)
    c = 1
    Set initial = initial.Offset(0, c)
    listofstores = listofstores & " " & Store
    Store = ""


    Next i
    End Function

Answer 1

Short but intricate.

1. uses Evaluate to return an array of matches (Store numbers vx)
2. Filter removes the non-matches ("V")
3. Join to make the string from the final array of matches

UDF

Function Getx(Rng1 As Range, Rng2 As Range) As String
Getx = Join(Filter(Evaluate("=ÏF(" & Rng2.Address & "=""x""," & Rng1.Address & ",""V"")"), "V", False), ",")
End Function

Answer 2

Another way to achieve is as below. You can do any where in sheets

Sub Main()
    Call getlistofstores(Range("G13:L15"), Range("G12:L12"))
End Sub

Function getlistofstores(stores As Range, listofstores As Range)
    Application.Volatile
    Dim fullconcatstring As String
    Dim row As Integer
    Dim column As Integer
    a = stores.Count / listofstores.Count
    b = listofstores.Count
    row = stores.Cells(1).row
    column = stores.Cells(1).column + (b)
    For i = 1 To a
        For j = 1 To b
            If stores.Cells(i, j) = "x" Then
                If concatstring <> "" Then
                    concatstring = concatstring & ", " & listofstores.Cells(j)
                Else
                    concatstring = listofstores.Cells(j)
                End If
            End If
        Next j
        fullconcatstring = fullconcatstring & Chr(10) & Chr(11) & concatstring
        concatstring = ""
    Next i
    Call concatenateallstores(row, column, fullconcatstring)
End Function

Sub concatenateallstores(r As Integer, c As Integer, d As String)
    str1 = Split(d, Chr(10) & Chr(11))
    str2 = UBound(str1)
    For i = 1 To str2
        Cells(r, c) = str1(i)
        r = r + 1
    Next i
End Sub