Search and pull Keywords from text string

[rajtak]

Hello Everyone,

Would it be possible to pull specific keywords from a text string.

As an example, you will find list of keywords in Column D and the result that I am expecting is in column B. For example: 'wowhead' is listed as a keyword in column D and it is found in the first title so the result should be 'wowhead' in column B, similarly, 'property' and 'certificates' are also listed in column D and both keywords are mentioned in title 2 hence the result should be 'property, certificates' in column B and so on.

Please let me know if this can be achieved by using excel formula or VB script.

 

[diddi]

I would investigate the InStr( ) function in VBA

 

[rajtak]

Thank you, diddi. I do not know how to code a VB script, all i know how to execute it in excel Alt+F11.

If you could provide a full code or an excel formula would really be appreciated.

 

[Marcelo Branco]

Paste this UDF in a standard module

Function aconcat(A As Variant, Optional sep As String = "") As String
' Harlan Grove, Mar 2002
    Dim y As Variant


    If TypeOf A Is Range Then
        For Each y In A.Cells
            aconcat = aconcat & y.Value & sep
        Next y
    ElseIf IsArray(A) Then
        For Each y In A
            aconcat = aconcat & y & sep
        Next y
    Else
        aconcat = aconcat & A & sep
    End If


    aconcat = Left(aconcat, Len(aconcat) - Len(sep))
End Function

Array formula in B2 copied down
=SUBSTITUTE(Aconcat(IF(ISNUMBER(SEARCH($D$2:$D$11,A2)),", "&$D$2:$D$11,"")),", ","",1)

confirmed with Ctrl+Shift+Enter

Hope this helps

M.

 

[diddi]

insert a new module and paste this in. make sure the sheet with the data is your active sheet

Sub SearchText()
    Dim Keys
    
    ReDim Keys(Cells(Rows.Count, "D").End(xlUp).Row - 1)
    For Row = 2 To Cells(Rows.Count, "D").End(xlUp).Row
        Keys(Row - 1) = Cells(Row, 4)
    Next Row
    
    For Row = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        For Key = 1 To UBound(Keys)
            If InStr(1, Cells(Row, 1), Keys(Key)) Then
                temp = temp & Keys(Key) & ", "
            End If
        Next Key
        Cells(Row, 2) = Left(temp, Len(temp) - 1)
        temp = ""
    Next Row
End Sub

 

[rajtak]

Hi Marcelo,

Thank you for the UDF, it works exactly what i wanted but when i changed the cell range, it adds commas at the end. Please find a screenshot below:

 

[rajtak]

Hi Diddi,

Thank you for your help. When I hit Run button an error pops up. Please find attached screenshot.

 

[Marcelo Branco]

Hi Marcelo,

Thank you for the UDF, it works exactly what i wanted but when i changed the cell range, it adds commas at the end.

Try

B2 copied down
=SUBSTITUTE(Aconcat(IF($D$2:$D$1000<>"",IF(ISNUMBER(SEARCH($D$2:$D$1000,A2)),", "&$D$2:$D$1000,""),"")),", ","",1)

Ctrl+Shift+Enter

M.

 

[rajtak]

Try

B2 copied down
=SUBSTITUTE(Aconcat(IF($D$2:$D$1000<>"",IF(ISNUMBER(SEARCH($D$2:$D$1000,A2)),", "&$D$2:$D$1000,""),"")),", ","",1)

Ctrl+Shift+Enter

M.

Thanks a ton for your help

 

[Rick Rothstein]

Here is another UDF for you to consider (it can also be called from other VBA code if need be) which has a much simpler calling mechanism from within a worksheet formula.

Function GetWords(Text As String, WordList As Variant) As String
  Dim W As Variant, Words As Variant
  For Each W In WordList
    If " " & UCase(Text) & " " Like "*[!A-Z]" & UCase(W) & "[!A-Z]*" Then
      If Len(W) Then GetWords = GetWords & ", " & W
    End If
  Next
  GetWords = Mid(GetWords, 3)
End Function

This function differs from what has been submitted earlier in the following ways...

1) My function finds words from the Keywords List as exact words. Given that, if you had the word "train" in your Keyword List, then "train" would be found only where it was not embedded within another word, like strainer for example (try that with the other code you have received).

2) Because of the way the function works, as described in #1 above, you cannot assume the function will automatically handle plurals (or any other alternate forms of the word for that matter), so whereas your Keyword List had "certificate" in it and wanted "certificates" returned (cells A3/B3 from you example data), my code won't do that... if you want both "certificate" and "certificates" returned, both words must be in your Keyword List. I feel this is good thing given no reasonably constructed code would handle irregular plurals (such as radius..radii).

3) My function is case insensitive which I assumed you wanted given you had "wowhead" in the Keyword List and it matched "Wowhead" in cell A2 for your example data. I can change this if you want.

4) Calling my function from a worksheet cell (using your posted data as an example) is as simple as putting this in cell B2 and copying it down...

=GetWords(A2,D$2:D$11)