Multi s/sheets, change from all UPPER to upper & lower

Shelly68

Board Regular
Joined
Sep 12, 2006
Messages
73
We have a file with 12 spreadsheets that are all typed entirely in UPPERCASE, can I change the whole lot to Upper & Lower, I understand using proper but don't want to have to do this individually on each grid
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

HalfAce

MrExcel MVP
Joined
Apr 6, 2003
Messages
9,456
Hello Shelly68,
There are a few ways to handle this.
The first suggestion would be to check out ASAP Utilities.
http://www.asap-utilities.com/

Hundreds of cool features & functions, this being just one of them.

Hope it helps.
 

Smitty

Legend
Joined
May 15, 2003
Messages
29,536
I'm on a new PC and can't post the code itself (or rewrite it as I don't have Office installed either..), but check out this link to Ivan Moala's Text Converter

HTH,

Smitty

Nevermind...Ace beat me to it... :biggrin:

(Dan, check out www.mgear.com, they've got some killer closeouts on skis right now...)
 

galileogali

Well-known Member
Joined
Oct 14, 2005
Messages
748
Try this code

Code:
Sub PROPERC()
Dim SH As Worksheet
Dim RNGSH As Range
Dim RANGOAUX As Variant

For Each SH In ActiveWorkbook.Worksheets
    Set RNGSH = SH.UsedRange
    RANGOAUX = RNGSH
    RANGOAUX = Application.Proper(RANGOAUX)

    RNGSH.Value = RANGOAUX
    Set RNGSH = Nothing

Next SH


End Sub

GALILEOGALI
 
Joined
Jul 30, 2006
Messages
3,656
Shelly68,

I have combined several macros to accomodate your request.

Try this FIRST on a COPY of your workbook.

Press and hold down the 'ALT' key, and press the 'F11' key.

Insert a Module in your VBAProject, Microsoft Excel Objects

Copy the below code, and paste it into the Module1.

Rich (BB code):
Option Explicit
Sub TextCaseChange()
' Page 322
' VBA & Macros for Microsoft Excel
' by Bill Jelen & Tracy Syrstad
'
' and
'
' FindLastCell
' http://www.ozgrid.com/VBA/ExcelRanges.htm
'
' Modified 07/22/2007 by Stanley D. Grom, Jr.
'
   
    Dim RgText As Range
    Dim oCell As Range
    Dim Ans As String
    Dim strTest As String
    Dim sCap As Integer
    Dim lCap As Integer
    Dim i As Integer
    Dim wSheet As Worksheet
    Dim LastColumn As Integer
    Dim LastRow As Long
    Dim LastCell As Range
    Dim strLastCellAddress As String

    ' FindLastCell
    ' http://www.ozgrid.com/VBA/ExcelRanges.htm
    If WorksheetFunction.CountA(Cells) > 0 Then
        'Search for any entry, by searching backwards by Rows.
        LastRow = Cells.Find(What:="*", After:=[A1], _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious).Row
        'Search for any entry, by searching backwards by Columns.
                LastColumn = Cells.Find(What:="*", After:=[A1], _
                    SearchOrder:=xlByColumns, _
                    SearchDirection:=xlPrevious).Column
                strLastCellAddress = Cells(LastRow, LastColumn).Address
    End If
    strLastCellAddress = Replace(strLastCellAddress, "$", "")
    Range("A1:" & strLastCellAddress).Select
Again:
    Ans = Application.InputBox("[L]owercase" & vbCr & "ppercase" & vbCr & _
            "entence" & vbCr & "[T]itles" & vbCr & "[C]apsSmall", _
            "Type in a Letter", Type:=2)
    
    If Ans = "False" Then Exit Sub
    If InStr(1, "LUSTC", UCase(Ans), vbTextCompare) = 0 Or Len(Ans) > 1 Then GoTo Again
    
    On Error GoTo NoText
    If Selection.Count = 1 Then
        Set RgText = Selection
    Else
        Set RgText = Selection.SpecialCells(xlCellTypeConstants, 2)
    End If
    On Error GoTo 0
    Application.ScreenUpdating = False
    For Each wSheet In Worksheets
        wSheet.Select
        If WorksheetFunction.CountA(Cells) > 0 Then
            'Search for any entry, by searching backwards by Rows.
            LastRow = Cells.Find(What:="*", After:=[A1], _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious).Row
            'Search for any entry, by searching backwards by Columns.
                    LastColumn = Cells.Find(What:="*", After:=[A1], _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious).Column
                    strLastCellAddress = Cells(LastRow, LastColumn).Address
        End If
        strLastCellAddress = Replace(strLastCellAddress, "$", "")
        Range("A1:" & strLastCellAddress).Select
        Set RgText = Selection.SpecialCells(xlCellTypeConstants, 2)
        For Each oCell In RgText
            Select Case UCase(Ans)
                Case "L": oCell = LCase(oCell.Text)
                Case "U": oCell = UCase(oCell.Text)
                Case "S": oCell = UCase(Left(oCell.Text, 1)) & _
                    LCase(Right(oCell.Text, Len(oCell.Text) - 1))
                Case "T": oCell = Application.WorksheetFunction.Proper(oCell.Text)
                Case "C"
                        lCap = oCell.Characters(1, 1).Font.Size
                        sCap = Int(lCap * 0.85)
                        'Small caps for everything.
                        oCell.Font.Size = sCap
                        oCell.Value = UCase(oCell.Text)
                        strTest = oCell.Value
                        'Large caps for 1st letter of words.
                        strTest = Application.Proper(strTest)
                        For i = 1 To Len(strTest)
                            If Mid(strTest, i, 1) = UCase(Mid(strTest, i, 1)) Then
                                oCell.Characters(i, 1).Font.Size = lCap
                            End If
                        Next i
            End Select
        Next oCell
        Range("A1").Select
    Next wSheet
    Range("A1").Select
    Application.ScreenUpdating = True
    Exit Sub
NoText:
    Range("A1").Select
    Application.ScreenUpdating = True
    MsgBox "No Text in your selection @ " & Selection.Address
End Sub




Try this FIRST on a COPY of your workbook.

Then run the 'TextCaseChange' macro.

Have a great day,
Stan
 

HalfAce

MrExcel MVP
Joined
Apr 6, 2003
Messages
9,456
Yep, that code was one of the ways I was referring to.

And thanks Smitty. Tried that link. Said it could not be found & try again.
Not really looking for skis. Actually haven't even seen mine (brand new skis, bindings, boots, poles, everything) since my very first trip down the mountian on a board. (Bought two new boards since then and I honestly don't even know where my skis are.) :LOL:
 

Forum statistics

Threads
1,181,372
Messages
5,929,565
Members
436,679
Latest member
helly123

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top