How to extract a code from a sentence?

[olympiac]

How to extract a code from a sentence?
I have got a text narrative from which I need to extract a code made up by 4 letters in Capital letter.
The code can be at the beginning, in the middle or at the end of the sentence but it's always separated from the other words.
Example with the code ADBC into the sentence:
long sentence here ABCD sentence continues
long sentence here ABCD
ABCD long sentence here
I have got 50 different codes and more than 10,000 rows from which I need to extract the code and insert it into a new column.
Is there a way to find a formula that can do this work?
Thanks

 

[olympiac]

Great! It works.

Many thanks for your support.

 

[p45cal]

Question 2:
What about if I want to search the code only within the last 10 words of the sentence?

Scope creep!

Function ExtractCapitals2(Str As String, LastXwords As Long) As String
Application.Volatile
On Error GoTo handler
zzz = Split(Application.Trim(Str), " ")
nw = UBound(zzz)
If nw > LastXwords - 1 Then
    Str = ""
    For i = nw - LastXwords + 1 To nw
        Str = Str & zzz(i) & " "
    Next i
End If
With CreateObject("VBScript.RegExp")
    .Pattern = "[A-Z]{4,}"
    ExtractCapitals2 = .Execute(Str)(0)
End With
Exit Function
handler:
ExtractCapitals2 = "Code missing in last " & LastXwords & " words"
End Function

Use as follows:
=ExtractCapitals2(A6,10)
where the 10 indicates only the last 10 words should be examined. Now you can use any other (positive) number in the formula instead of 10.

 

[Hermanito]

Well p45cal, it seems he didn't need regular expressions after all...

At least you helped me by showing how easy it is to use them in VBA

 

[p45cal]

Tweaks to eliminate some errors:

Function ExtractCapitals2(Str As String, Optional LastXwords) As String
Application.Volatile
On Error GoTo handler
zzz = Split(Application.Trim(Str), " ")
nw = UBound(zzz)
If nw > 0 Then
    If Not IsMissing(LastXwords) Then
        If nw > LastXwords - 1 Then
            Str = ""
            For i = nw - LastXwords + 1 To nw
                Str = Str & zzz(i) & " "
            Next i
        End If
    End If
End If
With CreateObject("VBScript.RegExp")
    .Pattern = "[A-Z]{4,}"
    ExtractCapitals2 = .Execute(Str)(0)
End With
Exit Function
handler:
If IsMissing(LastXwords) Then
    ExtractCapitals2 = "Code missing"
Else
    ExtractCapitals2 = "Code missing in last " & LastXwords & " words"
End If
End Function

 

[olympiac]

What do I need to change in the code to get a function that checks in cell "A1" if there is one of the 50 different combinations? I added in the module some of the other codes but it doesn't work. Do I need to add a "OR" somewhere in the module?
.Pattern = "ABCD"
.Pattern = "ABBD"
etc...

 

[Sektor]

...
.Pattern = "(ABCD|ABBD|AAAA)"
...

You can fill pattern this way:

    Dim i As Integer
    Dim arrCapitals As Variant
    Dim sPattern As String
    
    arrCapitals = Array("AAAA", "BBBB", "CCCC", "DDDD")
    
    For i = LBound(arrCapitals) To UBound(arrCapitals)
        sPattern = sPattern & arrCapitals(i) & "|"
    Next
    
    pattern = "(" & Left(sPattern, Len(sPattern) - 1) & ")"

...
   .Pattern = sPattern