Retrieving several matches from a string excel

Question

Sorry if this is a stupid question but i've been racking my brain for a couple of days now and i can't seem to come up with a solution to this.

I have a list of phrases and a list of keywords that need to be searched, extracted and replaced.

For example i have the following list of keywords in sheet 1 column A that need to be extracted and replaced with the keywords in column B.

red      -     orange

blue     -     violet

green    -     pink

yellow   -     brown

And in sheet 2 I have a list of phrases in column A.

The girl with blue eyes had a red scarf.

I saw a yellow flower.

My cousin has a red car with blue rims and green mirrors.

And I want to extract in column B the keywords that are matched for every phrase in the exact order that they appear like so:

COLUMN A                                                        COLUMN B

The girl with blue eyes had a red scarf.                        violet, orange

I saw a yellow flower.                                          brown

My cousin has a red car with blue rims and green mirrors.       orange, violet, pink

Is there any way this can be achieved either by formula or VBA? Also this needs to be usable with Excel 2016 so i can't use fancy functions like "TEXTJOIN".

Thank you everyone in advance!

Cheers!

L.E.

I was able to find some code that almost does what I need it to do but it does not keep the correct order.

Is there anyway it could be modified to generate the desired results? Unfortunately I'm not that good with VBA. :(

Sub test()
Dim datacount As Long
Dim termcount As Long

datacount = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
termcount = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To datacount

    dataa = Sheets("Sheet1").Cells(i, "A").Text
    
    result = ""
            
    For j = 1 To termcount
    
        terma = Sheets("Sheet2").Cells(j, "A").Text
        termb = Sheets("Sheet2").Cells(j, "B").Text
        
        If InStr(dataa, terma) > 0 Then
        
             
        If result = "" Then
           
           result = result & termb
           
        Else
        
            result = result & ", " & termb
            
        End If
            
        End If
        
    Next j
    
       Sheets("Sheet1").Cells(i, "B").Value = result
    
    Next i
End Sub

Answer 1

I would suggest you use Power Query which is a built-in function since Excel 2013.

Suppose the text strings of colours on your Sheet1 is in a Table named Tbl_LookUp

Suppose the phrases on your Sheet2 is in another Table named Tbl_Phrases

Go to the Data tab of your Excel and load both tables to the Power Query Editor (you can google how to load data from a table to the PQ Editor in Excel 2016). Please note the screenshot is from Excel 365.

Once loaded, go to the Tbl_Phrases query, and action the following steps:

1. Add an indexed column starting from 1
2. Split the Phrases column by delimiter, use space as the delimiter and choose to put the outcome into rows
3. Merge the current query with the Tbl_LookUp query, use the Phrase column to match the Old Text column
4. Expand the new column to show contents from New Text column
5. Group the New Text column by the Index column, you can choose to sum the values in the New Text column, and it will come up as an error after the grouping. Go to the formula field and replace this part of the formula List.Sum([New Text]) with Text.Combine([New Text],", "). Hit enter and the error will be corrected to the desired text string.

The following is the full M Code for the above query. You can copy and paste it in the Advanced Editor without manually going through each step:

let
    Source = Excel.CurrentWorkbook(){[Name="Tbl_Phrases"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Phrases", type text}}),
    #"Added Index" = Table.AddIndexColumn(#"Changed Type", "Index", 1, 1, Int64.Type),
    #"Split Column by Delimiter" = Table.ExpandListColumn(Table.TransformColumns(#"Added Index", {{"Phrases", Splitter.SplitTextByDelimiter(" ", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Phrases"),
    #"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Phrases", type text}}),
    #"Merged Queries" = Table.NestedJoin(#"Changed Type1", {"Phrases"}, Tbl_LookUp, {"Old Text"}, "Tbl_Replace", JoinKind.LeftOuter),
    #"Expanded Tbl_Replace" = Table.ExpandTableColumn(#"Merged Queries", "Tbl_Replace", {"New Text"}, {"New Text"}),
    #"Grouped Rows" = Table.Group(#"Expanded Tbl_Replace", {"Index"}, {{"Look up color", each Text.Combine([New Text],", "), type nullable text}})
in
    #"Grouped Rows"

When you finish adding an index column in the Tbl_Phrases query, which is Step 1 from the above, you can make a copy of the query (simply right click the original query and select "duplicate"), then you will have a second query called Tbl_Phrases (2). No need to work on this query until you finish editing the original query ended up with desired text strings.

Then you can merge the Tbl_Phrases (2) query with the Tbl_Phrases query using the index column. Expand the new column to show the content from the look up colour column. Lastly, merge the Phrases column with the look up color column with delimiter (space)-(space), and remove the index column, then you should have the desired text string.

Here is the M Code for the Tbl_Phrases (2) query. Just a reminder, you must finish with the Tbl_Phrases query first otherwise the merging query step will lead to an error:

let
    Source = Excel.CurrentWorkbook(){[Name="Tbl_Phrases"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Phrases", type text}}),
    #"Added Index" = Table.AddIndexColumn(#"Changed Type", "Index", 1, 1, Int64.Type),
    #"Merged Queries" = Table.NestedJoin(#"Added Index", {"Index"}, Tbl_Phrases, {"Index"}, "Tbl_Phrases", JoinKind.LeftOuter),
    #"Expanded Tbl_Phrases" = Table.ExpandTableColumn(#"Merged Queries", "Tbl_Phrases", {"Look up color"}, {"Look up color"}),
    #"Merged Columns" = Table.CombineColumns(#"Expanded Tbl_Phrases",{"Phrases", "Look up color"},Combiner.CombineTextByDelimiter(" - ", QuoteStyle.None),"Merged"),
    #"Removed Columns" = Table.RemoveColumns(#"Merged Columns",{"Index"})
in
    #"Removed Columns"

You can then load the Tbl_Phrase (2) query to the desired worksheet within the same workbook (or to somewhere on Sheet2).

Let me know if you have any questions.

Answer 2

You can do this with a User Defined Function making use of Regular Expressions.

The worksheet formula:

=matchWords(A2,$K$2:$L$5)

where A2 contains the sentence, and the second argument points to the translation table (which could be on another worksheet).

The code

Option Explicit
Function matchWords(ByVal s As String, translTbl As Range) As String
    Dim RE As Object, MC As Object, M As Object
    Dim AL As Object 'collect the replaced words
    Dim TT As Variant
    Dim I As Long
    Dim vS As Variant
'create array
TT = translTbl

'initiate array for output
Set AL = CreateObject("system.collections.arraylist")

'initiate regular expression engine
Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = True
    .ignorecase = True 'could change this if you want
    .Pattern = "\w+" 'can change this if need to include some non letter/digit items
    
    'split the sentence, excluding punctuation
    If .test(s) Then
        Set MC = .Execute(s)
            For Each M In MC
                For I = 1 To UBound(TT, 1)
                    If M = TT(I, 1) Then AL.Add TT(I, 2)
                Next I
            Next M
    End If
End With
    
matchWords = Join(AL.toarray, ", ")
    
End Function