Autofit Row Height on Both: Column with Merged Cells AND Column with Single Cells

Question

I'm generating a giant Excel template using VBA. There is one standard column of merged cells that contains various descriptions with different lengths. Alone this standard description column is fine because all rows are currently set the the correct lengths.

The second column is made up of single cells for user comments which will always have different text lengths. Of course, when user inputs are set as values for predetermined cells: it is likely that lines of text will be cut off. This is a common problem and it's obvious the solution is to set a macro to run row height autofit.

This is where the issues begin.

When row height autofit is run on the second column for user comments, many of the merged cells in the first column of descriptions are set to a row height too small to show all their text.

Any ideas on how to run row-height autofit the second column of user comments without decreasing the row height of the first column?

Is there a way to set a minimum row-height and still run autofit?

Answer 1

This worked for me. It resizes the first column's merged cells by adjusting the row height of the last cell if the text will otherwise be cut off.

A slightly more complex version might divide the height difference between all of the rows in the merged area instead of adding it to a single row. I can leave that as an exercise...

Sub FixHeights()

Dim rng As Range, col As Range, m As Range, c As Range
Dim i As Long, n As Long, fh
Dim fHeights()

    Set rng = Range("B4:C11") 'for example...

    'to store merged areas and their fitted heights
    ReDim fHeights(1 To rng.Rows.Count, 1 To 2)

    'run though the first column and find merged
    '  areas and "fitted heights"
    Set col = rng.Columns(1)
    n = 0
    For Each c In col.Cells
        Set m = c.MergeArea
        If m.Cells.Count > 1 And c.Row = m.Cells(1).Row Then
            n = n + 1
            Set fHeights(n, 1) = m
            fHeights(n, 2) = GetFittedHeight(m)
        End If
    Next c

    'autofit the second column row heights
    rng.Columns(2).Rows.AutoFit

    'recheck the first column: if any merged area is
    '  too short, then increase the last row's height
    For i = 1 To n
        Set m = fHeights(i, 1)
        fh = fHeights(i, 2)
        Debug.Print m.Height, fh
        If m.Height < fh Then
            With m.Cells(m.Cells.Count)
                .RowHeight = .RowHeight + (fh - m.Height)
            End With
        End If
    Next i

End Sub

'get the "fitted height" of a merged area
Function GetFittedHeight(ma As Range)
Dim ht
    With ma
        .UnMerge
        .Cells(1).EntireRow.AutoFit
        ht = .Cells(1).RowHeight
        .Merge
        .EntireRow.AutoFit
    End With
    GetFittedHeight = ht
End Function