auto fit merged cells

is it possible to auto fit the height of merged cells? I need a Comment section that can grow as needed for long tet

select cells and run

Sub AutoFitRowsHeight()
Dim j&, q&, f&, l&, p&(3), cWh!, rHh!, i() As Box, cl() As Single, x As Object, objRange As Object
Application.ScreenUpdating = False
Set objRange = Selection
On Error Resume Next
With ActiveSheet
    For Each x In objRange.Areas
        Set x = IIf(x.Address = .Rows.Address Or x.Address = .Columns(x.Column).Address, .UsedRange, x): p(0) = x.Column
        p(1) = p(0) + x.Columns.Count - 1: p(2) = x.Row: p(3) = p(2) + x.Rows.Count - 1: ReDim cl(p(0) To p(1)): ReDim i(p(2) To p(3))
        For j = p(0) To p(1): cl(j) = .Columns(j).ColumnWidth: Next
        For j = p(3) To p(2) Step -1
            Set x = .Rows(j): i(j).Hdn = x.Hidden: x.AutoFit: i(j).Hght = x.RowHeight
            For l = p(0) To p(1)
                If .Cells(j, l).MergeCells Then
                    With .Cells(j, l).MergeArea
                        If ActiveSheet.Cells(j, l).Address = .Item(1).Address Then
                            For q = l To l + .Columns.Count - 1: cWh = cWh + cl(q) + 0.647: Next
                            If cWh > 255 Then cWh = 0: GoTo L1
                            For q = j To j + .Rows.Count - 1
                                If Not i(q).Hdn Then rHh = rHh + i(q).Hght: If f = 0 Then f = q
                            Next
                            .UnMerge: .Item(1).ColumnWidth = cWh: x.AutoFit: rHh = x.RowHeight - (rHh - i(f).Hght)
                            If f <> j Then If i(f).Hght < rHh Then .Rows(f - j + 1).RowHeight = rHh
                            .Merge: .Item(1).ColumnWidth = cl(l): l = l + .Columns.Count - 1
                            If i(f).Hght < rHh Then i(f).Hght = rHh
                            cWh = 0: rHh = 0: f = 0
                        End If
                    End With
                End If
L1:        Next
            If i(j).Hght > 0 Then x.RowHeight = i(j).Hght
            If i(j).Hdn Then x.Hidden = True
        Next
    Next
End With
End Sub