Concatenate array elements based on search results of a single cell

[trishcollins]

I have a table with a column named "Description" and another column "Tags". I have a named range "tag_data" that lists all the tags I want to search for in the description, and then concatenate the tags into the Tag Column:

I am using a function I named ConcatenateArrary based on a ConcatenateIf function I found.

The "Tag_data" is the named_range is a list of tags in a single column of a table ("WLM", "Cloud", "Digicom", etc.). I use this named range to search the "description". If the tag is found in the description, I want it added to the "Tag" field.

For example the brief description says "Cloud connectivity for DND WLM", I want to say "Cloud, WLM" in the tag field

Here is the code I have so far, but it doesn't work.

Function ConcatenateArray(CriteriaRange As Range) As Variant
'Range is the cell, Variant is the Array with the tags
Dim xResult As String
arr1 = Range("Tag_Data")
Dim i As Long
Dim counti As Long
counti = 1
For i = LBound(arr1, 1) To UBound(arr1, 1)
If Search(arr1, CriteriaRange) Then
If counti = 1 Then
xResult = arr1(i, 1)
Else
xResult = xResult & ", " & arr1(i, 1)
End If
End If
Next i
ConcatenateArrary = xResult
Exit Function
End Function

 

[DanteAmor]

Try this

<b>Sheet</b><br /><br /><table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:223px;" /><col style="width:149px;" /><col style="width:80px;" /><col style="width:80px;" /><col style="width:80px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >I</td><td >J</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td style="background-color:#ffff00; font-weight:bold; text-align:center; ">Description</td><td style="background-color:#ffff00; font-weight:bold; text-align:center; ">Tags</td><td > </td><td > </td><td style="background-color:#92d050; font-weight:bold; text-align:center; ">Tag_data</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td >Cloud connectivity for DND WLM</td><td >Cloud, WLM</td><td > </td><td > </td><td >WLM</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td >Digicom for DND WLM</td><td >Digicom, WLM</td><td > </td><td > </td><td >Cloud</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td > </td><td > </td><td > </td><td > </td><td >Digicom</td></tr></table><br /><table style="font-family:Arial; font-size:10pt; border-style: groove ;border-color:#00ff00;background-color:#fffcf9; color:#000000; "><tr><td ><b></b></td></tr><tr><td ><table border = "1" cellspacing="0" cellpadding="2" style="font-family:Arial; font-size:9pt;"><tr style="background-color:#cacaca; font-size:10pt;"><td >Cell</td><td >Formula</td></tr><tr><td >B2</td><td >=ConcatenateArray(A2)</td></tr></table></td></tr></table> <br /><br />

Function ConcatenateArray(CriteriaRange As Range) As Variant
    Dim wItems As Variant, b As Range, cTag As String
    wItems = Split(CriteriaRange, " ")
    For i = 0 To UBound(wItems)
        Set b = Range("tag_data").Find(wItems(i), LookIn:=xlValues, lookat:=xlWhole)
        If Not b Is Nothing Then cTag = cTag & ", " & wItems(i)
    Next
    If cTag <> "" Then ConcatenateArray = Mid(cTag, 3)
End Function

 

[trishcollins]

Wow! Works great. Any way I can change the result if there are no tags. Currently it displays "0", and I just want it to be blank. Also, if it finds more than one instance, it repeats it. For instance "WAN, WAN" as it found the tag twice in one description. I just one to see it once in the tags column. Thanks again.

Trish

 

[DanteAmor]

Use this

Function ConcatenateArray(CriteriaRange As Range) As Variant
    Dim wItems As Variant, b As Range, cTag As String
    ConcatenateArray = ""
    wItems = Split(CriteriaRange, " ")
    For i = 0 To UBound(wItems)
        Set b = Range("tag_data").Find(wItems(i), LookIn:=xlValues, lookat:=xlWhole)
        If Not b Is Nothing Then
            If InStr(1, ConcatenateArray, wItems(i)) = 0 Then
                ConcatenateArray = ConcatenateArray & ", " & wItems(i)
            End If
        End If
    Next
    If ConcatenateArray <> "" Then ConcatenateArray = Mid(ConcatenateArray, 3)
End Function

 

[trishcollins]

Excellent. Worked like a dream. Saved me hours trying to figure it out myself. If I wanted to reuse this function, and pass the named range to the function, can you show me how?

One other note, I see you are looking for only works separated by a space (I think that's what you are doing). That is not always the case.

I have a tag in the named ranged called "Phoenix" and it shows the tag from this statement: "NCR-PWGSC-NS-16_RCD-Phoenix DR - Complete Buildout of Phoenix DR at EDC Gatineau
" but not this one "NCR-PWGSC-NS-16_NCO-Phoenix Disaster Recovery-Solution/Pricing for 17/18 - Project-AMENDMENT OF 22186", the former having spaces around the word, the latter does not.

Trish

 

[DanteAmor]

=ConcatenateArray(rName)

But rName must be only one cell. Do you want it for a range of cells?

Try this please:

Function ConcatenateArray(CriteriaRange As Range) As Variant
    Dim wItems As Variant, b As Range, cTag As String, cad As String
    ConcatenateArray = ""
    cad = Replace(CriteriaRange, "-", " ")
    cad = Replace(cad, "_", " ")
    cad = Replace(cad, "/", " ")
    cad = Replace(cad, "  ", " ")
    wItems = Split(cad, " ")
    For i = 0 To UBound(wItems)
        Set b = Range("tag_data").Find(wItems(i), LookIn:=xlValues, lookat:=xlWhole)
        If Not b Is Nothing Then
            If InStr(1, ConcatenateArray, wItems(i)) = 0 Then
                ConcatenateArray = ConcatenateArray & ", " & wItems(i)
            End If
        End If
    Next
    If ConcatenateArray <> "" Then ConcatenateArray = Mid(ConcatenateArray, 3)
End Function

 

[trishcollins]

That worked. This has been so helpful.

No, I would only perform the function on one cell at a time, and just pass the two variables, the named range containing the list of tags, and the cell to look at. Also, is there a way to ensure it doesn't care about case, as I just noticed it picked up the Tag WIFI in the description twice, once as WIFI and once as Wifi. It's only in the named range as "Wifi"

Tag "WIFI, Wifi" Description "NCR-PWGSC-NS-16_WIFI-Space accommodation at Pace du centre - Wifi required ASAP - Urgent-SA"

Trish

 

[DanteAmor]

Try this:

Function ConcatenateArray(CriteriaRange As Range) As Variant
    Dim wItems As Variant, b As Range, cTag As String, cad As String
    ConcatenateArray = ""
    cad = Replace(CriteriaRange, "-", " ")
    cad = Replace(cad, "_", " ")
    cad = Replace(cad, "/", " ")
    cad = Replace(cad, "  ", " ")
    wItems = Split(cad, " ")
    For i = 0 To UBound(wItems)
        Set b = Range("tag_data").Find(wItems(i), LookIn:=xlValues, lookat:=xlWhole)
        If Not b Is Nothing Then
            If InStr(1, [COLOR=#0000ff]LCase[/COLOR](ConcatenateArray), [COLOR=#0000ff]LCase[/COLOR](wItems(i))) = 0 Then
                ConcatenateArray = ConcatenateArray & ", " & wItems(i)
            End If
        End If
    Next
    If ConcatenateArray <> "" Then ConcatenateArray = Mid(ConcatenateArray, 3)
End Function

 

[trishcollins]

Perfect. The LCase worked. I only see one instance of WIFI now.

So if I wanted to pass the variable for the named range (in this case it would be "tag_data") to the function, rather than hardcode it into the function ie. "Set b = Range("tag_data").Find(wItems(I), …..", how would I do that? If was able to pass the variable for the named range I could perform this same function on other cells with using different named ranges.

Thanks in advance...Trish

 

[DanteAmor]

It would be like this

=ConcatenateArray(A7,Tag_Data)

Function ConcatenateArray(CriteriaRange As Range, [B][COLOR=#0000ff]NamedRange[/COLOR][/B] As Range) As Variant
    Dim wItems As Variant, b As Range, cTag As String, cad As String
    ConcatenateArray = ""
    cad = Replace(CriteriaRange, "-", " ")
    cad = Replace(cad, "_", " ")
    cad = Replace(cad, "/", " ")
    cad = Replace(cad, "  ", " ")
    wItems = Split(cad, " ")
    For i = 0 To UBound(wItems)
        Set b = [B][COLOR=#0000ff]NamedRange[/COLOR][/B].Find(wItems(i), LookIn:=xlValues, lookat:=xlWhole)
        If Not b Is Nothing Then
            If InStr(1, LCase(ConcatenateArray), LCase(wItems(i))) = 0 Then
                ConcatenateArray = ConcatenateArray & ", " & wItems(i)
            End If
        End If
    Next
    If ConcatenateArray <> "" Then ConcatenateArray = Mid(ConcatenateArray, 3)
End Function