CODEWITHSUNDEEP
excelvba
Titas aleksandravičius
Titas aleksandravičius

Reputation: 35

UDF to concatenate values

I am trying to build a user defined function using VBA for excel. That would concatenate a list of stores which has a x 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

Upvotes: 2

Views: 1190

Answers (2)

Karthick Gunasekaran
Karthick Gunasekaran

Reputation: 2713

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

enter image description here

Upvotes: 1

brettdj
brettdj

Reputation: 55682

Short but intricate.

  1. uses Evaluate to return an array of matches (Store numbers v x)
  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

enter image description here

Upvotes: 4

Related Questions