VBA retrieve multiple items from one cell

[Heather515]

Hi,

I need help to retrieve multiple items from one cell. Data and results are shown below. I want to get multiple keywords from one cell. I created a dictionary. However, it can only retrieve one item from the cell. For example, in B2 and B6, it only shows 300. Thanks.

Function VBA(Rng As Range)

Dim dict As Dictionary

Set dict = New Dictionary

dict("Apple") = "300"
dict("Orange") = "400"
dict("Cat") = "500"
dict("Banana") = "600"


VBA = ""
For Each Key In dict.Keys
If InStr(Rng.Text, Key) Then
VBA = dict(Key)
Exit For
End If
Next

End Function

 

[JEC]

How about

Function jec(cell As String) As Variant
 Dim ar, ar2, c00, i
 ar = Array("Apple", "Orange", "Cat", "Banana")
 ar2 = Array(300, 400, 500, 600)
 
 For i = 0 To UBound(ar)
   If InStr(cell, ar(i)) Then c00 = c00 & " " & ar2(i)
 Next
 jec = Mid(c00, 2)
End Function

 

[FormR]

Hi, any reason for not using native functions?

If you have no objections, here's an option you can try (probably doesn't require committing with Ctl+Shift+Enter with your 365 subscription - but might do.)

Book1
	A	B	C	D	E	F
1	Text	Formula Result			Search for	Return
2	notenotenoteApplenoteOrangeCatNote	300 400 500			Apple	300
3	noteCatBanananotenotenote	500 600			Orange	400
4	notenotenote				Cat	500
5	OrangenotenoteCatNote	400 500			Banana	600
6	BanananotenoteApple	300 600
Sheet1

Cell Formulas
Range	Formula
B2:B6	B2	=TEXTJOIN(" ",TRUE,IF(ISNUMBER(FIND($E$2:$E$5,A2)),$F$2:$F$5,""))
Press CTRL+SHIFT+ENTER to enter array formulas surrounded with curly braces.

 

[Heather515]

How about

Function jec(cell As String) As Variant
 Dim ar, ar2, c00, i
 ar = Array("Apple", "Orange", "Cat", "Banana")
 ar2 = Array(300, 400, 500, 600)
 
 For i = 0 To UBound(ar)
   If InStr(cell, ar(i)) Then c00 = c00 & " " & ar2(i)
 Next
 jec = Mid(c00, 2)
End Function

Thanks. It works!

 

[Heather515]

Hi, any reason for not using native functions?

If you have no objections, here's an option you can try (probably doesn't require committing with Ctl+Shift+Enter with your 365 subscription - but might do.)

Book1
	A	B	C	D	E	F
1	Text	Formula Result			Search for	Return
2	notenotenoteApplenoteOrangeCatNote	300 400 500			Apple	300
3	noteCatBanananotenotenote	500 600			Orange	400
4	notenotenote				Cat	500
5	OrangenotenoteCatNote	400 500			Banana	600
6	BanananotenoteApple	300 600
Sheet1

Cell Formulas
Range	Formula
B2:B6	B2	=TEXTJOIN(" ",TRUE,IF(ISNUMBER(FIND($E$2:$E$5,A2)),$F$2:$F$5,""))
Press CTRL+SHIFT+ENTER to enter array formulas surrounded with curly braces.

Good idea! It works perfectly!

 

[Peter_SSs]

I am guessing that is not your real data, but just a slight word of warning. If it is possible that one word could also be part of another word, you could get unusual results.
Here is an example with the worksheet formula suggestion where 4 numbers are returned where I suspect you would only want "300 400 500" returned?
A similar situation could also arise with the UDF suggestion.

If we knew what your real data was like (see XL2BB) then it may be possible to avoid such situations if indeed they are possible.

Heather515.xlsm
	A	B	C	D	E	F
1	Text	Formula Result			Search for	Return
2	notenotenoteApplenoteOrangeCaterpillarNote	300 400 500 700			Apple	300
3					Orange	400
4					Caterpillar	500
5					Banana	600
6					Cat	700
Sheet1

Cell Formulas
Range	Formula
B2	B2	=TEXTJOIN(" ",TRUE,IF(ISNUMBER(FIND($E$2:$E$6,A2)),$F$2:$F$6,""))

 

[Heather515]

I am guessing that is not your real data, but just a slight word of warning. If it is possible that one word could also be part of another word, you could get unusual results.
Here is an example with the worksheet formula suggestion where 4 numbers are returned where I suspect you would only want "300 400 500" returned?
A similar situation could also arise with the UDF suggestion.

If we knew what your real data was like (see XL2BB) then it may be possible to avoid such situations if indeed they are possible.

Heather515.xlsm
	A	B	C	D	E	F
1	Text	Formula Result			Search for	Return
2	notenotenoteApplenoteOrangeCaterpillarNote	300 400 500 700			Apple	300
3					Orange	400
4					Caterpillar	500
5					Banana	600
6					Cat	700
Sheet1

Cell Formulas
Range	Formula
B2	B2	=TEXTJOIN(" ",TRUE,IF(ISNUMBER(FIND($E$2:$E$6,A2)),$F$2:$F$6,""))

Thanks for the warning. I encountered the problems you mentioned. I figured out a workaround that replaces some words so each keyword I want to return value with is unique and doesn't include part of any other words.