Change cell range to Uppercase

A

ADK

I have found help on websites on converting a cell text to uppercase upon
entry. I would like to do this when a commandbutton is clicked instead and
go thru a select range of cells changing all cells within the range to
uppercase if not already uppercase.

Key part: "if not already uppercase"

Here is code that works but is there a way to increase its speed ...such as
scanning for lowercase ...I'm assuming that this code is literally going to
each cell and doing the procedure even if it is all uppercase.

Private Sub UpperCaseButton_Click()

On Error GoTo addError

Application.Run "Module5.UnProtectPDSR"

Dim cell As Range
Dim LastRow As String

'Process to select range
'Finds last row with next in column V
LastRow = Range("V10000").End(xlUp).Row
LastRow = "E7:J" & LastRow
Range(LastRow).Select

For Each cell In Selection.Cells
If cell.HasFormula = False Then
cell = UCase(cell)
End If
Next

Range("A7").Select
Application.Run "Module5.ProtectPDSR"

Exit Sub

addError:
MacName = "UpperCaseButton"
MyErrorRoutine Err.Number, Err.Description, MacName

End Sub
 
G

Guest

There is no easy way to Upper Case a range of cells. The only method is
similar to what you have. If your problem is one of performace there are a
couple of things to consider...
Turn off screen updating and calculation.
Remove the Application.Run commands as they are slow to execute
Remove the select statements... So something more like this...

Private Sub UpperCaseButton_Click()
Dim cell As Range
dim rngToSearch as Range

On Error GoTo addError

with application
.screenupdating = false
.calculation = xlCalculationManual
end with
'Application.Run "Module5.UnProtectPDSR" 'Replace This
Call Module5.UnProtectPDSR

rngToSearch = Range(Range("E7"), _
Cells(Cells(Rows.Count, "V").End(xlUp).Row, "E")

For Each cell In rngToSearch
If cell.HasFormula = False Then cell.Value = UCase(cell.Value)
Next cell

'Application.Run "Module5.ProtectPDSR" 'Replace this
Call Module5.ProtectPDSR
with application
.screenupdating = true
.calculation = xlCalculationAutomatic
end with


Exit Sub

addError:
with application
.screenupdating = true
.calculation = xlCalculationAutomatic
end with

MacName = "UpperCaseButton"
MyErrorRoutine Err.Number, Err.Description, MacName

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top