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

[Shelly68]

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

 

[HalfAce]

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]

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...

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

 

[galileogali]

Try this 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

 

[stanleydgromjr]

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.

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]

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.)

 

[Shelly68]

That's perfect,

many many thanks Stan,


Shelly