Extract a string of text from a cell

[RattlingCarp3048]

this one is tripping me up big time. via formula or VBA. Column P contains numerous rows ranging from 1-1500 in any given month. Each cell in column P contains a paragraph of information. Somewhere within each paragraph is a brief statement "x of x cores". i need to extract that statement from each cell. unfortunately "x of x cores" can be any combination of "zero of one core" or "two of four cores" or "four of four cores" or "zero of three cores" etc all the way up to four of four and the numbers are always spelled out.

any ideas how to make this happen?

Column P random paragraph	extracted result
;jlasijfaoij asolifdj ; ashdfa hfosdf ;oa ufoa two of two cores aosihfo ahsodfh sofah ashdf o	two of two cores
klaslfjas sldkjf asjd asljfoij fofheoiwehf J;OASDHF OW j;asld % aofh # of % one of three oiaskdn aoshf a oiasofi	one of three cores
oiafj;as oasfan aofa oai foajf oaiaf two of four cores aosifal oais f oai f oaif oj;oiashodfu %	two of four

 

[Akuini]

disregard the part about all the variations.... i have a solution to make those spacing corrections on our end.

if there is a way to account for the statement being more than once i think that would give me the best outcome.

So, the new requirements are:
1. there are 2 patternn: "X of x core(s)" & "X out of x core(s)"
2. there could be multiple occurrences in one cell, like: This is one of one core & that's two of three cores.

Is that correct?

 

[RattlingCarp3048]

Upload Mini-sheet

So, the new requirements are:
1. there are 2 patternn: "X of x core(s)" & "X out of x core(s)"
2. there could be multiple occurrences in one cell, like: This is one of one core & that's two of three cores.

Is that correct?

Yes. I wasn't aware of the 2nd pattern or the multiple occurrences. We have apparently been missing Datta as we haven't been searching for the additional patterns or occurrences

 

[Akuini]

Is it ok that the result:

1. always show "core" instead of "cores", like:

two of four cores something	two of four core

2. not always in the same order as the sentence, like:

This is three of four cores & that's two of three cores.	two of three core, three of four core

 

[RattlingCarp3048]

Is it ok that the result:

1. always show "core" instead of "cores", like:

two of four cores something	two of four core

2. not always in the same order as the sentence, like:

This is three of four cores & that's two of three cores.	two of three core, three of four core

yes "core" in the final result is perfectly fine.

 

[Scott Huish]

In regards to post #9, Why did you put the function in a sub? That's your problem.

 

[Burrgogi]

so i tried it again with @Burrgogi suggested edit which gave me this...
View attachment 111437

You need to remove the very 1st line that reads Sub Cores ().

Please refer to @lrobbo314 posting again on how to use that function!

 

[Akuini]

Try this one:

Sub RattlingCarp3048_4()
Dim i As Long, j As Long, k As Long
Dim tx As String
Dim va, vx, ary, vb
Dim regEx As Object

    ary = Split("zero one two three four")
    ReDim vx(1 To 30, 1 To 1)
    For i = 0 To UBound(ary)
        For j = i To UBound(ary)
            k = k + 1
            vx(k, 1) = ary(i) & " of " & ary(j) & " core"
            k = k + 1
            vx(k, 1) = ary(i) & " out of " & ary(j) & " core"
        Next
    Next
    
    va = Range("A1", Cells(Rows.Count, "A").End(xlUp))
    ReDim vb(1 To UBound(va, 1), 1 To 1)
    
        Set regEx = CreateObject("VBScript.RegExp")
    
        For i = 1 To UBound(va, 1)
            tx = LCase(va(i, 1))
            For Each x In vx
                regEx.Pattern = "\b" & x & "[s]{0,1}\b"
                If regEx.test(tx) Then
                    If InStr(tx, x) > 0 Then
                        vb(i, 1) = vb(i, 1) & ", " & x
                    End If
                End If
            Next
            If vb(i, 1) <> "" Then vb(i, 1) = Mid(vb(i, 1), 3, 50000)
        Next
    
Range("B1").Resize(UBound(vb, 1), 1) = vb
End Sub

Example:
Please, check notes in col C.

RattlingCarp3048 - regex.xlsm
	A	B	C
1	data
2	One of one core random paragraph	one of one core
3	Bone of one core random paragraph		<-- rejected because of bone
4	Y got what two of three cores he bid for	two of three core
5	Two out of four cores something	two out of four core
6	two out of four coress something		<-- rejected because of coress
7	random paragraph zero out of zero core	zero out of zero core
8	This is four of four cores & that's two of three cores.	two of three core, four of four core	<-- order of occurrences is different from the sentence
9	This is two of three cores & that's four of four cores.	two of three core, four of four core
10	two of three cores & two of three cores	two of three core	<-- Multiple occurrences are counted as one occurrence.
11	something of this core
12	This is the cores of his message.
13	The score gap is too high.
Sheet1

 

[RattlingCarp3048]

In regards to post #9, Why did you put the function in a sub? That's your problem.

I copy and pasted it into sheet mod and it prompted me to give a sub name. Where should it have been placed?

 

[Akuini]

I've amended my code a bit because InStr can be replaced with matches:

Sub RattlingCarp3048_5()
Dim i As Long, j As Long, k As Long
Dim tx As String
Dim va, vx, ary, vb
Dim regEx As Object, Matches As Object

    ary = Split("zero one two three four")
    ReDim vx(1 To 30, 1 To 1)
    For i = 0 To UBound(ary)
        For j = i To UBound(ary)
            k = k + 1
            vx(k, 1) = ary(i) & " of " & ary(j) & " core"
            k = k + 1
            vx(k, 1) = ary(i) & " out of " & ary(j) & " core"
        Next
    Next
    
    va = Range("A1", Cells(Rows.Count, "A").End(xlUp))
    ReDim vb(1 To UBound(va, 1), 1 To 1)
    
        Set regEx = CreateObject("VBScript.RegExp")
        With regEx
        For i = 1 To UBound(va, 1)
            tx = LCase(va(i, 1))
            For Each x In vx
                .Pattern = "\b" & x & "[s]{0,1}\b"
                If .test(tx) Then
                       Set Matches = .Execute(tx)
                       vb(i, 1) = vb(i, 1) & ", " & Matches(0)
                End If
            Next
            If vb(i, 1) <> "" Then vb(i, 1) = Mid(vb(i, 1), 3, 50000)
        Next
        End With
Range("B1").Resize(UBound(vb, 1), 1) = vb
End Sub

 

[Scott Huish]

I copy and pasted it into sheet mod and it prompted me to give a sub name. Where should it have been placed?

You needed to Insert a Module and place it there.