Extract uppercase words from string

**agf12555** · 11-21-2011, 02:03 PM

Hi,

I'm new at this, but really need help to save time on thousands of cells worth of manual work. I need to extract the uppercase words from strings of text. I'll give an example, and show which VBA code I found on my own and how it seemed to get me closer but not all the way there.

Example:

A1: The quick brown Fox Jumps over the lazy dog
A2: The Quick brown fox jumps over the lazy Dog

Ideally in B1: The Fox Jumps
B2: The Quick Dog

I found this code:

Public Function majuscules (zone)
Dim sel As Object
Dim i As Integer
Application.Volatile
For Each sel In zone
    For i = 1 To Len(sel)
        If Asc(Mid(sel, i, 10)) > 64 And Asc(Mid(sel, i, 10)) < 91 Then
            majuscules = majuscules & Mid(sel, i, 1)
        End If
    Next i
Next sel
End Function

.....Which only took the capital letter itself. From the above example:

Outcome B1: TFJ

Any help would be appreciated! Thanks.

**Dom83** · 11-21-2011, 02:59 PM

Hi,

See if this does the trick:

Public Function ExtractProperCase(ByVal sText As String)
    Dim iChar As Integer
    Dim iStart As Integer
    Dim sReturn As String
    
    For iChar = 1 To Len(sText)

        iStart = iChar

        If Asc(Mid$(sText, iChar, 1)) > 64 And _
            Asc(Mid$(sText, iChar, 1)) < 91 Then

            Do While Mid$(sText, iChar, 1) <> " " And _
                iChar < Len(sText) + 1
                iChar = iChar + 1
            Loop

            sReturn = sReturn & _
                Mid$(sText, iStart, iChar - iStart) & " "

        End If

    Next
    
    ExtractProperCase = Trim$(sReturn)
    
End Function

I haven't checked the asc numbers so I'll have to trust whoever wrote the original function on that one.

Cheers,
Dom