VBA - Applying PROPER format to range

[Fishboy]

Hi all,

In my Excel 2010 workbook I have a Workbook_BeforeClose event which applies a number of formatting rules across the sheet to maintain a level of uniformity. It is all working well as is, however the recent addition of applying the PROPER case formatting function has slowed things down a bit and I expect it is because of the For Each Cell in Rng part. Please see the offending bit of code highlighted in bold red below:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
Dim rng As Range, cell As Range
        Set rng = Range("A3:A1500")
        For Each cell In rng
            cell.Value = WorksheetFunction.Proper(cell.Value)
        Next cell
    Range("A3:AI1500").Select
        With Selection.Font
        .Name = "Calibri"
        .Size = 11
        .Color = vbBlack
        End With
    Worksheets("Drivers").Range("A3:AI1500").HorizontalAlignment = xlCenter
    Worksheets("Drivers").Range("B3:B1500").NumberFormat = "0#### ######"
    Worksheets("Drivers").Range("A3:AI1500").Borders.LineStyle = xlContinuous
    Worksheets("Drivers").Range("A3:C1500").BorderAround _
    Weight:=xlMedium
    Worksheets("Drivers").Range("H3:L1500").BorderAround _
    Weight:=xlMedium
    Worksheets("Drivers").Range("M3:X1500").BorderAround _
    Weight:=xlMedium
    Worksheets("Drivers").Range("Y3:AI1500").BorderAround _
    Weight:=xlMedium
    Range("A1").Select
    MsgBox "All formatting has been made uniform.  Please remember to save."
End Sub

Even with Application.Screenupdating set to False, the screen still flickers and the whole process takes about 15 or so seconds, up from the 2 or so seconds it used to be before adding in this bit of code.

What I would like to know is if there is a better way of applying PROPER to those 1497 cells without having to loop through each cell in turn? Is it possible to apply the rule to the whole range in it's entirety?

While we are at it, if anyone can think of a more streamlined way of achieving the desired results of the code in another way I am all ears.

Any help is greatly appreciated.

 

[Norie]

Try this.

Set Rng = Range("A3:A1500")

With Rng
    .Value = Evaluate("INDEX(PROPER(" & .Address & "),,1)")
End With

 

[Fishboy]

Try this.

Set Rng = Range("A3:A1500")

With Rng
    .Value = Evaluate("INDEX(PROPER(" & .Address & "),,1)")
End With

Awesome! Thanks Norie. That is lightning quick again, really appreciate the help.