Change Case of Text in Excel

Hi All,

Here is a procedure to change the case of text in Excel.

Code:

---

Sub ChangeCase()
   
    '// Developed by Krishnakumar @ ExcelFox.com on 10-Aug-2011
   
    Dim cType      As Long
    Dim r          As Range
    Dim strAddr    As String
    Dim txt        As String
    Dim i          As Long
    Dim n          As Long
    Dim Wrd        As String
    Dim a, x, j    As Long
   
    If WorksheetFunction.CountA(Selection) = 0 Then
        MsgBox "No data in selected range : " & Selection.Address(0, 0)
        Exit Sub
    End If
   
    On Error Resume Next
    cType = Application.InputBox("Enter Type No" & vbCrLf & vbCrLf & _
            "Type - 1: Proper Case" & vbTab & "Type - 2: UPPER CASE" & vbCrLf & _
            "Type - 3: Sentence case" & vbTab & "Type - 4: small case", "Change Case")
    On Error GoTo 0
   
    If cType > 0 And cType <= 4 Then
        strAddr = Selection.Address(0, 0)
        If InStr(1, strAddr, ",") = 0 Then
            a = Selection.Value
            If IsArray(a) Then
                For i = 1 To UBound(a, 1)
                    For n = 1 To UBound(a, 2)
                        If cType = 3 Then
                            a(i, n) = ProperCase(a(i, n))
                        Else
                            x = Split(a(i, n))
                            For j = 0 To UBound(x)
                                Wrd = x(j)
                                Select Case cType
                                    Case 1: txt = txt & " " & Application.Proper(Wrd)
                                    Case 2: txt = txt & " " & UCase(Wrd)
                                    Case 4: txt = txt & " " & LCase(Wrd)
                                End Select
                            Next
                            a(i, n) = Mid$(txt, 2): txt = ""
                        End If
                    Next
                Next
                With Selection
                    .Cells(1, 1).Resize(UBound(a, 1), UBound(a, 2)).Value = a
                End With
            Else
                x = Split(a)
                If cType = 3 Then
                    a = ProperCase(a)
                Else
                    For j = 0 To UBound(x)
                        Wrd = Trim$(x(j))
                        Select Case cType
                            Case 1: txt = txt & " " & Application.Proper(Wrd)
                            Case 2: txt = txt & " " & UCase(Wrd)
                            Case 4: txt = txt & " " & LCase(Wrd)
                        End Select
                    Next
                    a = Mid$(txt, 2): txt = ""
                End If
                With Selection
                    .Cells(1, 1) = a
                End With
            End If
        Else
            For Each r In Selection
                If cType = 3 Then
                    r = ProperCase(r.Text)
                Else
                    x = Split(r.Value)
                    For j = 0 To UBound(x)
                        Wrd = x(j)
                        Select Case cType
                            Case 1: txt = txt & " " & Application.Proper(Wrd)
                            Case 2: txt = txt & " " & UCase(Wrd)
                            Case 4: txt = txt & " " & LCase(Wrd)
                        End Select
                    Next
                    r = Mid$(txt, 2): txt = ""
                End If
            Next
        End If
    End If

End Sub

Private Function ProperCase(ByVal InputString As String) As String
       
    Dim x, i As Long, Wrd As String, Pos As Long, j As Long, Aasc As Long
   
    x = Split(InputString, ".")
    InputString = Empty
   
    For i = 0 To UBound(x)
        Wrd = x(i)
        Pos = 0
        For j = 1 To Len(Wrd)
            Aasc = Asc(Mid$(UCase$(Wrd), j, 1))
            If Aasc >= 65 And Aasc <= 90 Then
                Pos = j
                Exit For
            End If
        Next
        If Pos Then
            If Len(InputString) Then
                InputString = InputString & "." & UCase$(Left$(Wrd, Pos)) & LCase$(Mid$(Wrd, Pos + 1))
            Else
                InputString = UCase$(Left$(Wrd, Pos)) & LCase$(Mid$(Wrd, Pos + 1))
            End If
        Else
            If Len(InputString) Then
                InputString = InputString & "." & Wrd
            Else
                InputString = Wrd
            End If
        End If
    Next
   
    ProperCase = InputString
   
End Function

---

Select the range to change the case, run the macro ChangeCase.


Although Excel has 3 in-built functions to change the cases (PROPER, UPPER and LOWER), I hope this might also be a useful one :)