Find item(s) in a string within a cell, match to item(s) in a list, and output the matched item

[seleseped]

Hello,
I am working on a decision-making tool (using Excel 2013) which will help doctors choose an appropriate drug given a patient’s symptoms and the medications he is currently taking. Cell E9 (labeled “FirstChoice” on sheet 'Recommendation') will give the doctor treatment instructions which includes a drug category (or categories) from which to choose a drug. Cell F9 (labeled “ProductsFirst”) then will look for the drug category (or categories) in E9 and output the corresponding brand name drug product(s).

Cell E10 (“Alternative”) will give an optional drug category choice and also pull the brand name into F10 (labeled "ProductsSecond") using the same above concept.

The drug categories and products are:
Category - Product
SAMA - Atrovent
LAMA - Spiriva
SABA - Proair
LABA - Serevent
ICS - Aerobid
SAMA+SABA - Combivent
LAMA+LABA - Anoro
ICS+LABA – Advair

Here is a screen shot of the output as an example:

	Recommended Pharmacologic Management	Recommended Products
Recommended first choice	Initiate SABA+SAMA	SABA: Proair or Proventil or Ventolin
Alternative choice	Add LAMA, discontinue ICS	LAMA: Spiriva ICS: Aerobid

<tbody>
</tbody>

I initially thought that I could do this within Excel using text functions (e.g., FIND, SEARCH, MID, LEN, etc.) and a VLOOKUP array, or INDEX-MATCH but quickly realized that that was becoming overwhelming and cumbersome and that VBA would be more efficient. I now think I need to use VBA functions such as FOR EACH, LOOP, FIND NEXT, etc. but having never written such a complicated loop, find myself at a loss as to where to even start.

My son is learning Python programming and he thought that this could be accomplished in that code using the 'dictionary' function. Perhaps there's a similar function/method in VBA?

Full Disclosure: I posted this same request on another help site a couple of weeks ago, but have not received any solutions. Here's hoping that somebody on this board will be able to help me. My deadline is fast approaching.

I am willing to share the workbook if that will help. Many thanks in advance for your expertise. You all are the best!

 

[Snakehips]

saleseped,

Below is just an example of how I might test the strings in a range (e.g. B8:B9) against lookup data (E1:F10)

Excel Workbook
	B	C	D	E	F
1	*	*	*	Category	Product
2	*	*	*	SAMA	Atrovent
3	*	*	*	LAMA	Spiriva
4	*	*	*	SABA	Proair
5	*	*	*	LABA	Serevent
6	*	*	*	ICS	Aerobid
7	Recommended Products	*	*	SAMA+SABA	Combivent
8	Initiate SABA+SAMA	*	*	LAMA+LABA	Anoro
9	Add LAMA, discontinue ICS	*	*	ICS+LABA	Advair
10	*	*	*	SABA+SAMA	???
11	*	*	*	*	*
Sheet7

Run this code

Sub Meds()


For Each cell In Range("B8:B9")
MedArray = Split(Application.Trim(Application.Substitute(cell, ",", " ")), " ")
For i = 0 To UBound(MedArray)
On Error Resume Next
MedCat = 0
MedCat = Application.Match(MedArray(i), Range("E1:E10"), 0)
If Not IsError(MedCat) Then
Med = Range("F1").Offset(MedCat - 1)
MsgBox MedArray(i) & ": " & Med
End If
On Error GoTo 0
Next i
Next cell
End Sub

Hope that helps.

 

[seleseped]

Thanks for the quick reply! I will get to work on this and let you know how it goes. Again, thanks for your expertise. That is something I would never have come up with on my own.

Seleseped

 

[Snakehips]

In the example I have used substitute to avoid an issue with the comma that is in the B9 string. You would need to do similar if say a period might be on the end one of the categories.

You would also want to be able to either do direct look up for a combo such as SABA+SAMA or have that split (using the '+') in order to look up the two elements separately.

Hopefully it gives you something to work with.

Please keep me updated.

 

[Snakehips]

Is potential for a UDF ?

Excel Workbook
	B	C
6	*	*
7	Recommended Products	*
8	Initiate SABA+SAMA	SABA+SAMA: ???
9	Add LAMA, discontinue ICS and throw in some *LABA.	LAMA: Spiriva - ICS: Aerobid *- LABA: Serevent
10	*	*
Sheet7

Function MedProd(Cat As String)
MedArray = Split(Application.Trim(Application.Substitute(Application.Substitute(Cat, ",", " "), ".", " ")), " ")
For i = 0 To UBound(MedArray)
On Error Resume Next
MedCat = 0
MedCat = Application.Match(MedArray(i), Range("E1:E10"), 0)
If Not IsError(MedCat) Then
Med = Range("F1").Offset(MedCat - 1)
MedProd = MedProd & MedArray(i) & ": " & Med & " - "
End If
On Error GoTo 0
Next i
MedProd = Left(MedProd, Len(MedProd) - 3)
End Function

 

[seleseped]

Hello,
I was able to get the first suggestion for code to work and got the appropriate message boxes to appear. My next question is then, instead of using message boxes, is there a way to get the products to output into the corresponding cells in column C?

It seems as though your suggestion to use a UDF is the answer, but I can't get that bit of code to run. I pasted the code into the module for the sheet which contains cells B8, B9, etc. I am self-taught in VBA and very amateur (that probably goes without saying), so could you be so kind as to give me step-by-step instructions?

Again, I can't thank you enough for your time and kindness.

Is potential for a UDF ?
Sheet7

*	B	C
6	*	*
7	Recommended Products	*
8	Initiate SABA+SAMA	SABA+SAMA: ???
9	Add LAMA, discontinue ICS and throw in some *LABA.	LAMA: Spiriva - ICS: Aerobid *- LABA: Serevent
10	*	*

<colgroup><col style="width: 30px; font-weight: bold;"><col style="width: 380px;"><col style="width: 372px;"></colgroup><tbody>
</tbody>

Spreadsheet Formulas

Cell Formula C8 =MedProd(B8) C9 =MedProd(B9) <tbody> </tbody>

<tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4

Function MedProd(Cat As String)
MedArray = Split(Application.Trim(Application.Substitute(Application.Substitute(Cat, ",", " "), ".", " ")), " ")
For i = 0 To UBound(MedArray)
On Error Resume Next
MedCat = 0
MedCat = Application.Match(MedArray(i), Range("E1:E10"), 0)
If Not IsError(MedCat) Then
Med = Range("F1").Offset(MedCat - 1)
MedProd = MedProd & MedArray(i) & ": " & Med & " - "
End If
On Error GoTo 0
Next i
MedProd = Left(MedProd, Len(MedProd) - 3)
End Function

 

[Snakehips]

I too am self-taught amateur - piddling about with help on here now and again for the fun of it.

I have to dash out right now so for the time being to try the UDF you must have the function code in a Code module NOT the sheet's code module.

If you have no modules for this project then in the VBA editor, menu bar, click 'Insert' > 'Module' and paste the code into that white space.

 

[seleseped]

IT WORKS! (Mormon Tabernacle Choir singing "Hallelujah" in the background)
I have just one final (I hope) question . . . In order to save horizontal space, is there a way to list output categories with multiple products on separate lines instead of separating them with a hyphen on one continuous line? e.g.,
LABA: Serevent
SAMA: Atrovent
ICS: Aerobid, Flovent

I tried throwing vbnewline into a couple of lines of code, but it didn't seem to do anything:

MedProd = MedProd & MedArray(i) & ": " & Med & vbNewLine & " - "

MedProd = Left(MedProd, Len(MedProd) - 3) & vbNewLine

Thanks for your patience, Tony. As you are also self-taught, you gave me something to which to aspire!
Shelley

 

[Snakehips]

IT WORKS! (Mormon Tabernacle Choir singing "Hallelujah" in the background)
I have just one final (I hope) question . . . In order to save horizontal space, is there a way to list output categories with multiple products on separate lines instead of separating them with a hyphen on one continuous line? e.g.,
LABA: Serevent
SAMA: Atrovent
ICS: Aerobid, Flovent

I tried throwing vbnewline into a couple of lines of code, but it didn't seem to do anything:

MedProd = MedProd & MedArray(i) & ": " & Med & vbNewLine & " - "

MedProd = Left(MedProd, Len(MedProd) - 3) & vbNewLine

Thanks for your patience, Tony. As you are also self-taught, you gave me something to which to aspire!
Shelley

That's great and you are most welcome.

Try the revised function code below.
I have coded to reference the lists by named ranges rather than reference by address.
Define 'Category' as the full listing of Categories e.g. E1:E10 and 'Product' as just the header cell of the product listing e.g. F1

You will need to format the result cells to wrap text.

Function MedProd(Cat As String)
MedArray = Split(Application.Trim(Application.Substitute(Application.Substitute(Cat, ",", " "), ".", " ")), " ")
For i = 0 To UBound(MedArray)
On Error Resume Next
MedCat = 0
MedCat = Application.Match(MedArray(i), Range("Category"), 0)
If Not IsError(MedCat) Then
Med = Range("Product").Offset(MedCat - 1)
MedProd = MedProd & MedArray(i) & ": " & Med & Chr(10)
End If
On Error GoTo 0
Next i


MedProd = Left(MedProd, Len(MedProd) - 1)
End Function

Excel Workbook
	B	C	D	E	F
1	*	*	*	Category	Product
2	*	*	*	SAMA	Atrovent
3	*	*	*	LAMA	Spiriva
4	*	*	*	SABA	Proair
5	*	*	*	LABA	Serevent
6	*	*	*	ICS	Aerobid
7	Recommended Pharmacologic Management	Recommended Products	*	SAMA+SABA	Combivent
8	Initiate SABA+SAMA	SABA+SAMA: ???	*	LAMA+LABA	Anoro
9	Add LAMA, discontinue ICS and throw in some *LABA.	LAMA: SpirivaICS: Aerobid LABA: Serevent	*	ICS+LABA	Advair
10	*	*	*	SABA+SAMA	???
Sheet7

Good luck with the project.

 

[seleseped]

Again, THANK YOU! My boss thinks that I'm a genius.