search within a column for specific words and display the found words in the adjacent cells

[sammy1981]

[FONT=Helvetica Neue, Helvetica, Arial, sans-serif]see attached file, im trying to find out if any of the ingredients from column D exists in column A and display whatever ingredient is found in column B, is this possible? need to go through lots of ingredients and find anything that needs special instructions [/FONT]
[FONT=Helvetica Neue, Helvetica, Arial, sans-serif]see below example[/FONT]
[TABLE="width: 500"]
<tbody>[TR]
[TD]butylhydroxyanisole, lavender oil, methylparaben, purified landolin, purfied water[/TD]
[TD] [/TD]
[TD]A-alpha-C (2-Amino-9H-pyrido[2,3-b]indole)[/TD]
[/TR]
[TR]
[TD]Corn Starch, d&c Red #27 Aluminum Lake, d & c Red #30 Aluminum Lake, Flavors, Saccharin Sodium A-alpha-C (2-Amino-9H-pyrido[2,3-b]indole[/TD]
[TD][/TD]
[TD]Abiraterone acetate[/TD]
[/TR]
[TR]
[TD]CarboxyMethylcellulose sodium, Microcrystalline Cellulose,flavor, Acetylaminofluorene, Purified Water, Red 22, Red 28, Salicylic Acid, [/TD]
[TD][/TD]
[TD]Acetaldehyde[/TD]
[/TR]
[TR]
[TD]FD&C red #40 , propylene glycol, flavoring, sucrose, and water, soybean, oil and corn starch used as processing aids.[/TD]
[TD][/TD]
[TD]Acetamide[/TD]
[/TR]
[TR]
[TD]Famotidine, USP 20mg...... Acid Reducer[/TD]
[TD][/TD]
[TD]Acetazolamide[/TD]
[/TR]
[TR]
[TD]Purified Water, Citric Acid, Sodium Benzoate Octoxynol-9.[/TD]
[TD][/TD]
[TD]Acetochlor[/TD]
[/TR]
[TR]
[TD]Adipic Acid, FD&C Blue 1, FD&C Red 27 , FD&C Yellow 6, Acetaldehyde FD&C Yellow 10[/TD]
[TD][/TD]
[TD]Acetohydroxamic acid[/TD]
[/TR]
[TR]
[TD]Polyehtylene, Sodium Sarcoisnate, EDTA, Quaternium-15, Carbomer, acetate[/TD]
[TD][/TD]
[TD]2-Acetylaminofluorene[/TD]
[/TR]
</tbody>[/TABLE]
[FONT=&quot]
[/FONT]

 

[sammy1981]

Yes it does.

ok, i see now why it wasnt working, its case sensitive, can you make to be not case sensitive?

 

[Fluff]

Add the line in blue as shown

   Set Dic = CreateObject("scripting.dictionary")
   [COLOR=#0000ff]Dic.comparemode = vbTextCompare[/COLOR]
   For Each cl In Range("D2", Range("D" & Rows.Count).End(xlUp))

 

[sammy1981]

Add the line in blue as shown

   Set Dic = CreateObject("scripting.dictionary")
   [COLOR=#0000ff]Dic.comparemode = vbTextCompare[/COLOR]
   For Each cl In Range("D2", Range("D" & Rows.Count).End(xlUp))

thank you

 

[Fluff]

You're welcome

 

[Peter_SSs]

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.

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:

Book1
	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
Data

 

[sammy1981]

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.

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
Ingredient:
ACTIVE INGREDIENTS: butylhydroxyanisole, lavender oil, methylparaben, purified landolin, purfied water
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
Active Ingredient:CarboxyMethylcellulose sodium, Microcrystalline Cellulose,flavor, Purified Water, Red 22, Red 28, Salicylic Acid,
AF-2;[2-(2-furyl)-3-(5-nitro-2-furyl)]acrylamide	AF-2;[2-(2-furyl)-3-(5-nitro-2-furyl)]acrylamide
Antimony oxide (Antimony trioxide), Alcohol, Acetochlor	Antimony oxide (Antimony trioxide); Acetochlor
1-Amino-2,4-dibromoanthraquinone	1-Amino-2,4-dibromoanthraquinone

<colgroup><col style="width: 25pxpx"><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]1[/TD]

[TD="align: right"][/TD]

[TD="align: center"]2[/TD]

[TD="align: right"][/TD]

[TD="align: center"]3[/TD]

[TD="align: center"]4[/TD]

[TD="align: right"][/TD]

[TD="align: center"]5[/TD]

[TD="align: center"]6[/TD]

[TD="align: center"]7[/TD]

</tbody>

Data​

thanks for your input

i will take out all the duplicates and spaces from column D, it was the raw data i received but needs some clean up

this macro seems to work fairly well and it only picks up complete words and not just if its found within a word

will do some more testing and advise

is there any particular format column A needs to be?

 

[Peter_SSs]

is there any particular format column A needs to be?

No.

BTW, best not to fully quote long posts as it makes the thread harder to read/navigate. If you want to quote, just quote small, relevant parts only, as i have done here.

 

[sammy1981]

thanks
sorry, Im new to this forum but i see what you mean