Question

I’m slowly amending and expanding an If…ElseIf…Else statement (see post) to help me format a long list of categories and sub-categories (thanks marg & Lunatik).

I’ve assigned fixed row heights to 90% of the range/lines. Now I’m stuck on those cells with lots of text that wraps over two lines in a cell. Two lines of text does not fit in my 10.5 standard height.

I can’t simply refresh the screen as the statement says any line that isn’t exception one (bold), or exception two (superscript) should be 10.5pts. I need a third exception.
I currently have:

Sub setHeights()
Dim targetRange As Range
Dim targetCell As Range


Cells.Select
Selection.WrapText = True
Cells.EntireRow.AutoFit
Set targetRange = Range("B:B")
For Each targetCell In targetRange
    If Not IsEmpty(targetCell) Then
        If targetCell.Font.Bold Then
            targetCell.RowHeight = 15
        ElseIf targetCell.Characters(Len(targetCell), 1).Font.superscript Then
            targetCell.RowHeight = 14
        Else: targetCell.RowHeight = 10.5
        End If
    End If
Next targetCell
End Sub

Could I:

• Find those targetCells with over 60 characters (the width of the fixed column)
• Apply .WrapText to those specific targetCells
• AutoExpand ONLY those targetCells (therefore not overwriting my standard 10.5pt lines for other non exception targetCells).

Would this work? Would it need to be placed in a separate SubRoutine because of the parameters of the first? What on earth would it look like? (see my embarrassing effort below)

ElseIf targetCell.Characters(Len(TargetCell+60).TargetCell.WrapText Then
       targetCell.Autofit

Answer 1

This seems to work.

Sub setHeights()
    Dim targetRange As Range
    Dim targetCell As Range

    Set targetRange = Range("B:B")
    For Each targetCell In targetRange.Cells
        If Not IsEmpty(targetCell.Value) Then
            If targetCell.Font.Bold Then
                targetCell.RowHeight = 15
            ElseIf targetCell.Characters(Len(targetCell), 1).Font.Superscript Then
                targetCell.RowHeight = 14
            ElseIf Len(targetCell.Value) > 10 Then
                targetCell.WrapText = True
                targetCell.EntireRow.AutoFit
            Else: targetCell.RowHeight = 10.5
            End If
        End If
    Next targetCell
End Sub