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]

How is your data set up?
I have assumed it is in sets of three columns each from B:D through AC:AE as follows ;
1st column - The full statement
2nd column - The word
3rd column - The result

 

[Kilgore_elder]

I believe i made a mistake. Looking at the layout, I had the primary statement in Column B and then the requisite words in Column C, then the result would be in column D as in your illustration. I then run a calculation based on the result in Col D and list this in Column E. The three columns (C,D and E) are repeated in sequence, i.e. F, G, H, then I, J, K and so on until the end of the data set. I included the data of column B in Column F and then the word was in G and the result in H column. There was still no output in column H. I hope this makes sense. Your configuration above would include an additional column (4th) to accommodate the processing of the outcome in the 3rd column.

 

[footoo]

Post a one row example of what should be in B:K

 

[Kilgore_elder]

Hi footoo. I changed the "3" in "For c = 2 to 30 Step 3" to a "4" and it seems to be working now. I have added an additional column to include the statement before every calculation as I had described in my last reply and with the change to the macro, it seems to work without any further problems.

 

[Kilgore_elder]

Hi footoo. Do you still require this? Once that minor adjustment was made and I added the extra columns, there was no problem. As the sheet is an interim stage in the analysis process, the number of columns is not an issue. I have one further question. I assume that the macro is to be run while the relevant sheet is active. I need to run it from a dashboard and have it run in the background. Can I simply assign a button to the macro and have it run from another location? Once again, many thanks for your assistance in this.

 

[footoo]

Hi footoo. Do you still require this? Once that minor adjustment was made and I added the extra columns, there was no problem. As the sheet is an interim stage in the analysis process, the number of columns is not an issue.

Don't need anything if it's working.

I assume that the macro is to be run while the relevant sheet is active. I need to run it from a dashboard and have it run in the background. Can I simply assign a button to the macro and have it run from another location?

To run without the relevant sheet being active (or without the relevant workbook being active) :

Sub v()
Dim [COLOR=#ff0000]ws As Worksheet,[/COLOR] c%, rng As Range, cel As Range
Dim strArr() As String
Dim w As Variant, n%, x%, str$


[COLOR=#ff0000]Set ws = Workbooks("The workbook name.xlsm").Sheets("The sheet name")[/COLOR]


Application.ScreenUpdating = False
For c = 2 To 30 Step 4
    Set rng = [COLOR=#ff0000]ws.[/COLOR]Range([COLOR=#ff0000]ws.[/COLOR]Cells(2, c), [COLOR=#ff0000]ws.[/COLOR]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

The relevant workbook ("The workbook name.xlsm") must be open when the macro is run.
(If the macro is in a different workbook, can add code to open it if it is not already open.)

 

[mikerickson]

You could use this UDF.

If "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" is in A1, the formula =CenterKey(A1,"class",5) will return "about the state of the class. It is a poor example"

Function CenterKey(aString As String, keyWord As String, length_on_each_side As Long) As String
    Const Punctuation As String = ".,?"
    Dim CleanString As String
    Dim Words As Variant, CleanWords As Variant
    Dim i As Long, keyWordAt As Variant
    
    CleanString = aString
    For i = 1 To Len(Punctuation)
        keyWord = Replace(keyWord, Mid(Punctuation, i, 1), " ")
        CleanString = Replace(CleanString, Mid(Punctuation, i, 1), " ")
    Next i
    
    CleanString = WorksheetFunction.Trim(CleanString)
    keyWord = WorksheetFunction.Trim(keyWord)
    aString = WorksheetFunction.Trim(aString)
    
    CleanWords = Split(CleanString, " ")
    Words = Split(aString, " ")
    keyWordAt = Application.Match(keyWord, CleanWords, 0)
    
    If IsError(keyWordAt) Then
        CenterKey = vbNullString
    Else
        ReDim Preserve Words(0 To keyWordAt + length_on_each_side - 1)
        For i = 0 To keyWordAt - (length_on_each_side + 2)
            Words(i) = vbNullString
        Next i
        CenterKey = WorksheetFunction.Trim(Join(Words, " "))
    End If
End Function

 

[Kilgore_elder]

Thank you footoo. Your work on this has been exceptional. I believe this is all I will need and can consider the problem solved. Once again, many thanks.

 

[footoo]

If you want to enter mikerickson's UDF onto the worksheet instead of the hard coded result :

Sub v()
Dim ws As Worksheet, c%, rng As Range
Set ws = Workbooks("The workbook name.xlsm").Sheets("The sheet name")
[COLOR=#ff0000]For c = 2 To 30 Step 3[/COLOR]
    Set rng = ws.Range(ws.Cells(2, c), ws.Cells(Rows.Count, c).End(xlUp))
[COLOR=#ff0000]    rng.Offset(0, 2) = "=CenterKey(RC[-2],RC[-1], 5)"[/COLOR]
Next
End Sub

You will need to amend the lines highlighted in red to account for the changes you made to the number of columns.

 

[Kilgore_elder]

I understand the amendment to "For c = 2 To 30 Step 3", changing the 3 to 4, but this line, rng.Offset(0, 2) = "=CenterKey(RC[-2],RC[-1], 5)", Is not present in the macro. Do i simply add this after,
Set rng = ws.Range(ws.Cells(2, c), ws.Cells(Rows.Count, c).End(xlUp))?