Finding adjacent words in one cell by using a common word in another cell

[Kilgore_elder]

I have been grappling with this problem for some time. I have a list of statements, each of which is assigned to a cell (these are captured from another worksheet and stored in column B. In column C is a word that had been previously extracted from the statement. I want to capture the five words that are on either side of the captured word and list these words in column D. I tried using the MID function and setting the character length to 30, but this doesn't allow for those situations where 30 characters is too long or too short, such as at the end or start of a sentence. I need to capture whole words. I thought a regular expression may do the trick, but it would need to allow a variety of words in each cell of Column C.
To illustrate, the following statement might appear in Column B: "There is little I can say about the state of the class. It is a poor example of the teacher's skill and I don't wish to attend anymore". The keyword in Column C is "class", and so I need to identify "about the state of the class. It is a poor example".
Does that clarify my situation?
Any assistance would be greatly appreciated.
Many thanks in anticipation.
Kilgore_Elder.

 

[footoo]

Sub v()
Dim rng As Range, cel As Range
Dim strArr() As String
Dim w As Variant, n%, x%, str$
Set rng = Range([B2], Cells(Rows.Count, "B").End(xlUp))
On Error Resume Next
For Each cel In rng
    strArr = Split(cel, " ")
    n = -1
    For Each w In strArr
        n = n + 1
        If Trim(w) = cel(1, 2) Then Exit For
    Next
    If n = UBound(strArr) Then GoTo nxt
    For x = n - 5 To n + 5 Step 1
        str = str & " " & strArr(x)
    Next
    cel(1, 3) = Trim(str)
    str = ""
nxt: Next
On Error GoTo 0
End Sub

Above assumes the data starts in B2.
The word in column C must be exactly the same as that contained within column B - including any connected punctuation. So in the example you provided, column C would need to have "class." (i.e. including the full stop).
If there are less than 5 words before and/or after the col C word, then the lower number of words will be returned in col D.
If there is no match for the col C word, nothing will be returned in col D.

 

[Kilgore_elder]

Thank you footoo. It works very nicely. Can this be written as a function or when run, will it just run down the column until it comes to the end of the statements?

 

[Kilgore_elder]

Sorry to say this footoo, but I need it to ignore the punctuation. Further investigation suggests that a number of these statements will be proceeded by punctuation, either a comma or a full stop. Unless there is a way of capturing the punctuation as well when listing the word, i can't see any other way around it.

 

[footoo]

when run, will it just run down the column until it comes to the end of the statements?

Yes.

 

[footoo]

Sorry to say this footoo, but I need it to ignore the punctuation. Further investigation suggests that a number of these statements will be proceeded by punctuation, either a comma or a full stop. Unless there is a way of capturing the punctuation as well when listing the word, i can't see any other way around it.

Will it only be either a comma or a full stop?
Will there be any immediately preceding punctuation - i.e. not separated from the word by a space?

 

[footoo]

Try this :

Sub v()
Dim rng As Range, cel As Range
Dim strArr() As String
Dim w As Variant, n%, x%, str$
Set rng = Range([B2], Cells(Rows.Count, "B").End(xlUp))
On Error Resume Next
For Each cel In rng
    strArr = Split(cel, " ")
    n = -1
    For Each w In strArr
        n = n + 1
[COLOR=#ff0000]        If Replace(Replace(w, ".", ""), ",", "") = cel(1, 2) Then Exit For[/COLOR]
    Next
    If n = UBound(strArr) Then GoTo nxt
    For x = n - 5 To n + 5 Step 1
        str = str & " " & strArr(x)
    Next
    cel(1, 3) = Trim(str)
    str = ""
nxt: Next
On Error GoTo 0
End Sub

 

[Kilgore_elder]

Hi footoo. That was a superb tweak. It fixes the problem entirely. Can I modify the macro to accommodate more than column C? The format I have described occurs a number of times. To explain the situation, there are a number of words that are captured that appear in Columns C,F,I,L,O,R,U,X,AA,AD. In other words, 10 times on the sheet. I use the information for further analysis. I didn't mention this earlier, as i was not wanting to over-complicate the request. If I can make the modification, I'm happy to give it a try. I really do appreciate this help. It has been a great service.

 

[footoo]

Sub v()
Dim c%, rng As Range, cel As Range
Dim strArr() As String
Dim w As Variant, n%, x%, str$
Application.ScreenUpdating = False
For c = 2 To 30 Step 3
    Set rng = Range(Cells(2, c), Cells(Rows.Count, c).End(xlUp))
    On Error Resume Next
    For Each cel In rng
        If cel(1, 2) = "" Then GoTo nxt
        strArr = Split(cel, " ")
        n = -1
        For Each w In strArr
            n = n + 1
            If Replace(Replace(Trim(w), ".", ""), ",", "") = cel(1, 2) Then Exit For
        Next
        If n = UBound(strArr) Then GoTo nxt
        For x = n - 5 To n + 5 Step 1
            str = str & " " & strArr(x)
        Next
        cel(1, 3) = Trim(str)
        str = ""
nxt: Next
Next
On Error GoTo 0
End Sub

 

[Kilgore_elder]

Hi footoo. The macro populates Column C nicely, but doesn't progress to the subsequent columns.