If cell contains any of the words in a list, return the next word

[yits05]

Hello,

I know this is probably relatively simple, but I am trying to figure out how to construct a formula that checks to see if a cell contains any of the words from a list, and if so, returns the word to the immediate right of the identified word. So for example:

Text	Returned:	List
Hello my name is tom	my	Hello
It is nice to get to know you tom	to	Nice
Good to meet you, tom	you	Meet

Thank you!

 

[ranman256]

paste the code below into a module.
put cursor on the line to inspect, run: getNextWord
use it as: msgbox getNextWord()
or have it post the return value into a cell : Activecell.offset(0,1).value = getNextWord()

Note, the keywords list are in its own sheet: keywords

Public Function getNextWord()
Dim vWord, vLine, vRet
Dim i As Integer
Dim bEndNextWord As Boolean
Dim wsSrc As Worksheet
On Error Resume Next  'GoTo errWrd
Set wsSrc = ActiveSheet
GetAllKeywords
wsSrc.Activate
vLine = ActiveCell.Value
i = InStr(vLine, " ")
While i > 0
  vWord = LCase(Left(vLine, i - 1))
  vLine = Trim(Mid(vLine, i + 1))
  vRet = ""
  If bEndNextWord Then GoTo endit
 
  vRet = gcolKeywords(vWord)
  If Len(vRet) <> 0 Then bEndNextWord = True
     'return next word and end
 
  i = InStr(vLine, " ")
Wend
vWord = ""
endit:
getNextWord = vWord
Set wsSrc = Nothing
End Function


Private Sub GetAllKeywords()
Set gcolKeywords = New Collection
Dim vWord
  'get all keywords
Sheets("keywords").Activate
Range("A2").Select
While ActiveCell.Value <> ""
      vWord = LCase(ActiveCell.Value)
      gcolKeywords.Add vWord, vWord
   
   ActiveCell.Offset(1, 0).Select  'next row
Wend
End Sub

 

[yits05]

paste the code below into a module.
put cursor on the line to inspect, run: getNextWord
use it as: msgbox getNextWord()
or have it post the return value into a cell : Activecell.offset(0,1).value = getNextWord()

Note, the keywords list are in its own sheet: keywords

Public Function getNextWord()
Dim vWord, vLine, vRet
Dim i As Integer
Dim bEndNextWord As Boolean
Dim wsSrc As Worksheet
On Error Resume Next  'GoTo errWrd
Set wsSrc = ActiveSheet
GetAllKeywords
wsSrc.Activate
vLine = ActiveCell.Value
i = InStr(vLine, " ")
While i > 0
  vWord = LCase(Left(vLine, i - 1))
  vLine = Trim(Mid(vLine, i + 1))
  vRet = ""
  If bEndNextWord Then GoTo endit
 
  vRet = gcolKeywords(vWord)
  If Len(vRet) <> 0 Then bEndNextWord = True
     'return next word and end
 
  i = InStr(vLine, " ")
Wend
vWord = ""
endit:
getNextWord = vWord
Set wsSrc = Nothing
End Function


Private Sub GetAllKeywords()
Set gcolKeywords = New Collection
Dim vWord
  'get all keywords
Sheets("keywords").Activate
Range("A2").Select
While ActiveCell.Value <> ""
      vWord = LCase(ActiveCell.Value)
      gcolKeywords.Add vWord, vWord
  
   ActiveCell.Offset(1, 0).Select  'next row
Wend
End Sub

Thank you! Can I also just put =getNextWord(A2) formula in the adjacent cell, and drag down?

 

[Peter_SSs]

Punctuation is usually a problem with this sort of question, but see if the following is any use.

If you wanted to use standard worksheet functions you could try the column C formula I have used below but note how punctuation could be returned. Given there may be several possible punctuation marks(?), dealing with them by standard formula is problematic.

You could also try this much more compact user-defined function as used in column D.

BTW, if it is possible to occur,
- what should happen if 2 or more list words appear in the same sentence?
- what should happen if the list word is the last word in the sentence?

Function NextWord(sentence As String, Wordlist As Range) As String
  Dim RX As Object
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Ignorecase = True
  RX.Pattern = "\b(" & Join(Application.Transpose(Wordlist.Value), "|") & ")\b( \b)(.+?\b)"
  If RX.test(sentence) Then NextWord = RX.Execute(sentence)(0).submatches(2)
End Function

yits05_1.xlsm
	A	B	C	D
1	Text	List	Returned:	Returned:
2	Hello my name is tom	Hello	my	my
3	It is nice to get to know you tom	Nice	to	to
4	Good to meet you, tom	Meet	you,	you
5
6	No list words here
Next Word

Cell Formulas
Range	Formula
C2:C6	C2	=IFNA(TRIM(RIGHT(LEFT(SUBSTITUTE(REPLACE(A2,1,LOOKUP(LEN(A2),SEARCH(B$2:B$4,A2)),"")," ",REPT(" ",100)),200),100)),"")
D2:D6	D2	=NextWord(A2,B$2:B$4)

 

[yits05]

Punctuation is usually a problem with this sort of question, but see if the following is any use.

If you wanted to use standard worksheet functions you could try the column C formula I have used below but note how punctuation could be returned. Given there may be several possible punctuation marks(?), dealing with them by standard formula is problematic.

You could also try this much more compact user-defined function as used in column D.

BTW, if it is possible to occur,
- what should happen if 2 or more list words appear in the same sentence?
- what should happen if the list word is the last word in the sentence?

Function NextWord(sentence As String, Wordlist As Range) As String
  Dim RX As Object
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.Ignorecase = True
  RX.Pattern = "\b(" & Join(Application.Transpose(Wordlist.Value), "|") & ")\b( \b)(.+?\b)"
  If RX.test(sentence) Then NextWord = RX.Execute(sentence)(0).submatches(2)
End Function

yits05_1.xlsm
	A	B	C	D
1	Text	List	Returned:	Returned:
2	Hello my name is tom	Hello	my	my
3	It is nice to get to know you tom	Nice	to	to
4	Good to meet you, tom	Meet	you,	you
5
6	No list words here
Next Word

Cell Formulas
Range	Formula
C2:C6	C2	=IFNA(TRIM(RIGHT(LEFT(SUBSTITUTE(REPLACE(A2,1,LOOKUP(LEN(A2),SEARCH(B$2:B$4,A2)),"")," ",REPT(" ",100)),200),100)),"")
D2:D6	D2	=NextWord(A2,B$2:B$4)

Thanks a bunch - worked like a charm!

 

[Peter_SSs]

Thanks a bunch - worked like a charm!

You're welcome. I trust then that my extra couple of questions are not relevant. Thanks for the follow-up.