Loop through cells and change font

Question

I'm trying to loop through all cells in a row and change the font size using the following criteria:

If the font size is less than 10, then change the font size to 10

This works if all cells in the worksheet are the same font size. It returns null if any of the cells in the sheet have a different font size. If I have a font size of 8 in A1 and a size of 20 in A2, there is no change.

Sub SetSheetFont(ws As Worksheet)
    Dim x As Integer
    Dim NumRows As Long
    Application.ScreenUpdating = False
    NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
    Range("A1").Select
    With ws
        ' If the font size is lower than 10, set to 10
        For x = 1 To NumRows
            If .Cells.Font.Size < 10 Then .Cells.Font.Size = 10
            ActiveCell.Offset(1, 0).Select
        Next
        Application.ScreenUpdating = True
    End With
End Sub

The end goal is to loop through all cells in the column until there is a certain number of empty cells, then start on the next column (in this case B1).

How might I at least accomplish this in one column? I'm pretty sure I can get it working if I start there.

Maybe this could be a nice usecase for `FindFormat` and `ReplaceFormat`. Not sure though. — JvdV, Jan 03 '20 at 16:01
Also your loop doesn't really change each iteration. You're checking the same cells each time (the *entire sheet's cells*). If you intend to check the cells in column A, change `.Cells.` to `.Cells(x,1).` Then it'll loop through all the cells from row 1 to `numRows`, checking the cell in Column A. — BruceWayne, Jan 03 '20 at 16:01

score 3 · Answer 1 · answered Jan 03 '20 at 16:05

You can loop through all the cells in the UsedRange

Sub SetSheetFont(ws As Worksheet)
    Dim myCell As Range
    Application.ScreenUpdating = False
    With ws
        For each myCell in ws.UsedRange
            ' If the font size is lower than 10, set to 10
            If myCell.Font.Size < 10 Then myCell.Font.Size = 10
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Side note: in general, you want to avoid using select in your code

score 3 · Answer 2 · answered Jan 03 '20 at 16:18

As per my comment, I think this could be a good usecase for FindFormat and ReplaceFormat:

Dim x As Double

'Set ReplaceFormat just once
Application.ReplaceFormat.Clear
Application.ReplaceFormat.Font.Size = 10

'Set FindFormat in a For loop
For x = 1 To 9.5 Step 0.5
    Application.FindFormat.Clear
    Application.FindFormat.Font.Size = x
    ws.Cells.Replace What:="", Replacement:="", SearchFormat:=True, ReplaceFormat:=True
Next x

This prevents iteration over all ws.Cells. The loop is necessary because we cant set something like: Application.FindFormat.Font.Size < 10. And because Font.Size will auto-adjust (at least for me) to the nearest 0.5 (and 1 being the smallest size) we can step from 1 to 9.5 with a step of 0.5.

And as per your description, you might want to change it up to ws.UsedRange as per @cybernetic.nomad mentioned. So it would read: ws.UsedRange.Replace...

And as an additional option, OP can use `ws.Range("A1:C1000").Replace ...`. I always hesitate personally to use `UsedRange`, as it may not necessarily get what you expect the Used Range to be. And `.Cells.`, of course, does it over all cells. Just wanted to show the option of using a specific range also. :) — BruceWayne, Jan 03 '20 at 16:41

BruceWayne · Answer 3 · 2020-01-03T16:39:29.013

Keeping your code, as commented, you would want to access each cell (not all cells, which is what .Cells. does:

For x = 1 To NumRows
    If .Cells(x,1).Font.Size < 10 Then .Cells(x,1).Font.Size = 10
Next

This will loop through column A. (the 1 in .Cells(x,1)).

I would also suggest using .End(xlUp) instead of xlDown, in the event your column A has a blank row separating Data. If that's okay, then you can keep it...the other option is: NumRows = Range("A" & rows.count).End(xlUp).row (Also, use Long for x:

Sub SetSheetFont(ws As Worksheet)
    Dim x As Long, NumRows as Long
    Application.ScreenUpdating = False
    With ws
        NumRows = .Range("A" & rows.count).End(xlUp).Row
        ' If the font size is lower than 10, set to 10
        For x = 1 To NumRows
            If .Cells(x,1).Font.Size < 10 Then .Cells(x,1).Font.Size = 10
        Next
        Application.ScreenUpdating = True
    End With
End Sub

Edit: To be sure, xlDown will work, just note it'll stop at the first Empty cell. Using xlUp as I did, will be sure to get all rows in Column A...which may or may not be what you want.

`xlDown` might have been on purpose though, since OP mentioned *"loop through all cells in the column until there's a certain number of empty cells"*. A little unclear from OP's end I guess. Even so, a solid answer :) — JvdV, Jan 03 '20 at 16:27
@JvdV - Agreed on `xlDown`, I tried to note that in my Answer but I'll edit to clarify. — BruceWayne, Jan 03 '20 at 16:38

Loop through cells and change font

3 Answers3