Adjust row height of merged cells

Excels behaviour can be quite annoying from time to time. One prime example is adjusting the row height of merged cells.

Normally you would think you can adjust the row height of a merged area the same way you adjust it for single cells.

Nope! No matter what you try it will not work properly.

However, below method can solve this issue partly for you. It will adjust the row height for a handed merged range of cells, but it only works for merged cells in one row. So, feel free to adjust this function to your needs and don't forget to share it with those who are in need ;0).

Source Code

' @Author - Alexander Bolte
' @Description - Adjusting the row height to content similar to Excel standard function for wrapping cell content.
' This method only works for merged cells accross one row.
' @Param rng - a Range object referencing a merged area.
Public Sub adjustRowHeightOfMergedCells(ByRef rng As Range)
    Dim mergedWidth As Variant
    Dim firstCell As Range
    Dim newHeight As Double
    
    If rng.MergeCells Then
        mergedWidth = getColumnWidth(rng)
        rng.MergeCells = False
        Set firstCell = rng.Cells(1, 1)
        firstCell.Columns.ColumnWidth = mergedWidth
        firstCell.WrapText = True
        firstCell.EntireRow.AutoFit
        newHeight = firstCell.EntireRow.Height
        rng.MergeCells = True
        rng.Columns.ColumnWidth = (mergedWidth / rng.Columns.Count)
        ' Only adjust a rows height, if the current row height is smaller
        ' than the new height needed to display merged cells content properly.
        If rng.Rows.EntireRow.RowHeight < newHeight Then
            rng.Rows.EntireRow.RowHeight = newHeight
        End If
    End If
End Sub

Ok, now that we can adjust the row height of merged cells in Excel VBA, we have one question to answer.

How do I find merged cells?

The answer can be found in the source code below.

' @Author - Alexander Bolte
' @Description - Running through the columns of the handed range's parent worksheet used range,
' checking each cell in the first row of handed range for a valid MergedArea attribute
' and then returning the MergedArea.
' @Param srcRow - a Range object referencing a row in an Excel worksheet.
' @Param startCol - an Integer providing the start column from which a search for merged cells should begin.
Public Function getMergedCells(ByRef srcRow As Range, ByVal startCol As Integer) As Range
    Dim ws As Worksheet
    Dim testCell As Range
    Dim merged As Range
    Dim i As Integer
    
    Set ws = srcRow.Parent
    For i = startCol To ws.UsedRange.Columns.Count
        Set testCell = ws.Cells(srcRow.Row, i)
        Set merged = testCell.MergeArea
        If merged.Columns.Count > 1 Then
            Exit For
        Else
            Set merged = Nothing
        End If
    Next i
    
    Set getMergedCells = merged
End Function

And how can you put both together? I prefer a method that uses recursion to run through the different columns in a given row but you can also run iteratively through the columns.

' @Author - Aleaxander Bolte
' @Description - Running recursively through an Excel row, adjusting the row height to all merged cells content, if the row height is not already greater than the new row height.
' @Param ws - a Worksheet object the change should be applied on.
' @Param trgRow - the target row the change should be applied on.
Private Sub adjustRowHeightToContent(ByRef ws As Worksheet, ByVal trgRow As Long)
    Dim merged As Range
    
    Set merged = xReusableCode.getMergedCells(ws.Rows(trgRow), 1)
    ' Stop condition for recursion.
    If Not (merged Is Nothing) Then
        ' Adjust row height of merged cells.
        Call adjustRowHeightOfMergedCells(merged)
        ' Call recursively.
        Call adjustRowHeightToContent(ws, merged.Column + merged.Columns.Count - 1)
    End If
End Sub

There you go, all done. Hope it helps, even if you only get a hint on how to do it yourself.

Hits: 6572