Geek Answers Handbook

Excel VBA exam requires fine tuning to listen

Below is a function created by others that changes the text to the case of a sentence (the first letter of each headword). The function works well, except that it does not use the first letter of the first word. Another problem is that if the sentence is entered into all caps, the function does nothing. I am looking for some help in setting up a function to fix these issues.

Option Explicit 
Function ProperCaps(strIn As String) As String

Dim objRegex As Object
Dim objRegMC As Object
Dim objRegM As Object

Set objRegex = CreateObject("vbscript.regexp")
strIn = LCase$(strIn)

With objRegex
    .Global = True
    .ignoreCase = True
    .Pattern = "(^|[\.\?\!\r\t]\s?)([a-z])"

    If .test(strIn) Then
        Set objRegMC = .Execute(strIn)

        For Each objRegM In objRegMC
            Mid$(strIn, objRegM.firstindex + 1, objRegM.Length) = UCase$(objRegM)
        Next
    End If
End With

ProperCaps = strIn
End Function

Thanks Gary

0
source share
2 answers

I renamed the function to SentenceCase () and made a few more settings:

Public Function SentenceCase(ByVal str As String) As String
    Dim regEx As Object, regExM As Object, indx As Object, indxs As Object
    Set regEx = CreateObject("VBScript.RegExp")
    str = Replace$(str, vbNullChar, vbLf)
    str = Replace$(str, vbBack, vbLf)
    str = LTrim$(LCase$(str))
    With regEx
        .IgnoreCase = True
        .MultiLine = True
        .Global = True
        .Pattern = "(^|[\n\f\r\t\v\.\!\?]\s*)(\w)"
        If .Test(str) Then
            Set indxs = .Execute(str)
            For Each indx In indxs
                Mid$(str, indx.FirstIndex + 1, indx.Length) = UCase$(indx)
            Next
        End If
    End With
    SentenceCase = str
End Function

This is what I tested with:

MsgBox SentenceCase(" UPPER CASE SENTENCE." & _
                    vbCrLf & "next line!nEXT sENTENCE" & _
                    vbCr & "cr ! lower case" & _
                    vbLf & "lf .new sentence" & _
                    vbNullChar & " null?null char" & _
                    vbNullString & "nullString  spaces" & _
                    vbTab & "TAB CHAR.ttt" & _
                    vbBack & "back?  back char" & _
                    vbFormFeed & "ff  ff words" & _
                    vbVerticalTab & "vertical tab.| lower .case words")

Results:

test 1

test 2

test 3

Here you can find more information: Microsoft - regular expressions

+1

, , . , :

Sub SentenceCase(rng As Range) 
Dim V       As Variant 
Dim s       As String 
Dim Start   As Boolean 
Dim i       As Long 
Dim ch      As String 

Application.ScreenUpdating = False 
Application.EnableEvents = False 
ActiveSheet.Unprotect 

With rng 
    V = .Value 
    If IsDate(V) Or IsNumeric(V) Then Exit Sub 
    s = CStr(V) 
    Start = True 

    For i = 1 To Len(s) 
        ch = Mid$(s, i, 1) 
        Select Case ch 
        Case "." 
            Start = True 
        Case "?" 
            Start = True 
        Case "!" 
            Start = True 
        Case "a" To "z" 
            If Start Then ch = UCase$(ch) 
            Start = False 
        Case "A" To "Z" 
            If Start Then 
                Start = False 
            Else 
                ch = LCase$(ch) 
            End If 
        End Select 
        Mid$(s, i, 1) = ch 
    Next i 
    .Value = s 
End With 

ActiveSheet.Protect 
Application.ScreenUpdating = True 
Application.EnableEvents = True

Sub

, . .

0

More articles: