Some further comments about your original data sample.
a) Column D contains about 150 rows that have duplicates (eg "Acrylamide" in D11 and D12), and even triplicates ("Ethylene oxide" in D405:407). Is there any reason for that? Can you avoid that with your data? Any simplification should help as that list in column D is very long.
b) You are likely to get unexpected results. In post
#4 mumps raised the issue with "benzene" being part of a longer word "Trihydroxybenzene". I think I can deal with that instance (in a different way to what has been done in the thread so far) but there is a similar issue that is more of a problem as I see it. You have, for example, "Styrene" and "Styrene oxide" in column D. If column A contained the ingredient "Styrene oxide" any solution might return only "Styrene" in column B because that would be found first. That could be very hard to overcome.
c) Some of the items in column D contain one or more trailing spaces (eg D6 = "Acetazolamide " That is, 3 spaces at the end). As it also is making the checking more complex than it could be, can that get cleaned up in your data ?
Never-the-less, even with your original data format, I think this code gives fairly good results. Only fairly good because of point b) above. Note the "Styrene" issue in row 3 below.
Code:
Sub Find_Ingredients()
Dim RX As Object, M As Object
Dim a As Variant, b As Variant, itm As Variant
Dim i As Long
Dim Ingredients As String, tmp As String
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
RX.IgnoreCase = True
tmp = Replace(Application.Trim(Join(Application.Transpose(Range("D2", Range("D" & Rows.Count).End(xlUp))), "|")), " |", "|")
RX.Pattern = "([\[\]\(\)])"
tmp = RX.Replace(tmp, "\$1")
RX.Pattern = "(\b| )(" & tmp & ")(?=\b|\W|$)"
a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
ReDim b(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
Ingredients = ""
Set M = RX.Execute(Application.Trim(a(i, 1)))
For Each itm In M
Ingredients = Ingredients & "; " & Trim(itm)
Next itm
b(i, 1) = Mid(Ingredients, 3)
Next i
Range("B2").Resize(UBound(b)).Value = b
End Sub
My sample data has column D exactly as in your sample file from post
#3 but in column A I have made up some data that contains a few matches.
Results of the above code in column B:
| A | B |
|---|
| 1 | Ingredient: | |
| 2 | ACTIVE INGREDIENTS: butylhydroxyanisole, lavender oil, methylparaben, purified landolin, purfied water | |
| 3 | Zileuton, 1,4-Butanediol dimethanesulfonate (Busulfan) Glycerol N,N-Bis(2-chloroethyl)-2-naphthylamine (Chlornapazine) Styrene oxide | Zileuton; 1,4-Butanediol dimethanesulfonate (Busulfan); N,N-Bis(2-chloroethyl)-2-naphthylamine (Chlornapazine); Styrene |
| 4 | Active Ingredient:CarboxyMethylcellulose sodium, Microcrystalline Cellulose,flavor, Purified Water, Red 22, Red 28, Salicylic Acid, | |
| 5 | AF-2;[2-(2-furyl)-3-(5-nitro-2-furyl)]acrylamide | AF-2;[2-(2-furyl)-3-(5-nitro-2-furyl)]acrylamide |
| 6 | Antimony oxide (Antimony trioxide), Alcohol, Acetochlor | Antimony oxide (Antimony trioxide); Acetochlor |
| 7 | 1-Amino-2,4-dibromoanthraquinone | 1-Amino-2,4-dibromoanthraquinone |
<colgroup><col style="width: 25pxpx"><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Data
