We help IT Professionals succeed at work.

# VBA to change font size for cell with large text

on
Medium Priority
312 Views
Hi guys,

The following code works for a cell
If Len([C13]) > 27 Then [C13].Font.Size = 8 Else [C13].Font.Size = 9

however I need to cover a worksheet Range(C13:U500)

Please send the correct code.

Thank you,

Robert
Comment
Watch Question

## View Solution Only

Most Valuable Expert 2012
Top Expert 2012
Commented:
Assuming you want to do this test on every cell in the range(C13:U500):

``````Sub changeFont()
Dim r As Range
Dim rng As Range

Set rng = Range("C13:U500")

For Each r In rng
If Len(r.Value) > 27 Then
r.Font.Size = 8
Else
r.Font.Size = 9
End If
Next r
End Sub
``````

Dave

Commented:
Thank you Dave, works great

Commented:
Dave it works great however it is very slow to calculate any suggestions? Thank you
Most Valuable Expert 2012
Top Expert 2012

Commented:
``````Sub changeFontV2()
Dim r As Range
Dim rng As Range

Set rng = Range("C13:U500")

rng.Font.Size = 9
For Each r In rng
If Len(r.Value) > 27 Then
r.Font.Size = 8
End If
Next r
End Sub
``````

Dave
Most Valuable Expert 2012
Top Expert 2012

Commented:
And then, try this:

``````Sub changeFontV3()
Dim r As Range
Dim rng As Range
Dim rChange As Range

Set rng = Range("C13:U500")

rng.Font.Size = 9
For Each r In rng
If Len(r.Value) > 27 Then
If rChange Is Nothing Then
Set rChange = r
Else
Set rChange = Union(rChange, r)
End If
Next r
rChange.Font.Size = 8
End Sub
``````

Are any of these faster?

Dave

Commented:
Yes, thank you, the last one is great
Most Valuable Expert 2012
Top Expert 2012

Commented:
Unless it gets VERY VERY large, the Union should be a pretty fast player.  I sometimes do that to "mark" ranges that I want to do something with like delete, or whatever - and it occurred to me it might speed you up with font changes.

Take care,

Dave