Auto Fit Row Height Of Merged Cells

[jann6628]

Hi.

Is there any way i can make excel autofit row height of merge cells?

 

[jann6628]

In my sheet B50:H50 is merged, and i want excel to autofit the row 50.

Is that possible?

 

[MARK858]

Your merged cells are all on the same row and so you autofit the row the same as you would normally.
Are you getting a specific issue when trying this?

 

[jann6628]

I doesn't get an error, but it it doesnt work the normal way when you have merged cells.

I have tried many different VBA code, but they doesn't seem to work, or maybe i don't understand them.

 

[MARK858]

  Rows("2:2").AutoFit

Works for me if you aren't wrapping text etc. Please explain more.

 

[jann6628]

Yes. i am wrapping text i the range.

The range allows the user to enter a default text. The text is wrapped because the text may not exceed column H.

The row is the last row on the sheet, so I need the print range to be locked at the row 50 and column H.

 

[MARK858]

Try the code below by Smallman on a copy of your worksheet

Sub MergedAreaRowAutofit()
Dim j As Long
Dim n As Long
Dim i As Long
Dim MW As Double 'merge width
Dim RH As Double 'row height
Dim MaxRH As Double
Dim rngMArea As Range
Dim rng As Range

Const SpareCol  As Long = 26
Set rng = Rows("2:2")

With rng
  For j = 1 To .Rows.Count
     'if the row is not hidden
    If Not .Parent.Rows(.Cells(j, 1).Row) _
      .Hidden Then
       'if the cells have data
      If Application.WorksheetFunction _
        .CountA(.Rows(j)) Then
        MaxRH = 0
        For n = .Columns.Count To 1 Step -1
          If Len(.Cells(j, n).Value) Then
             'mergecells
            If .Cells(j, n).MergeCells Then
              Set rngMArea = _
                .Cells(j, n).MergeArea
              With rngMArea
                MW = 0
                If .WrapText Then
                   'get the total width
                  For i = 1 To .Cells.Count
                    MW = MW + _
                      .Columns(i).ColumnWidth
                  Next
                  MW = MW + .Cells.Count * 0.66
                   'use the spare column
                   'and put the value,
                   'make autofit,
                   'get the row height
                  With .Parent.Cells(.Row, SpareCol)
                    .Value = rngMArea.Value
                    .ColumnWidth = MW
                    .WrapText = True
                    .EntireRow.AutoFit
                    RH = .RowHeight
                    MaxRH = Application.Max(RH, MaxRH)
                    .Value = vbNullString
                    .WrapText = False
                    .ColumnWidth = 8.43
                  End With
                  .RowHeight = MaxRH
                End If
              End With
            ElseIf .Cells(j, n).WrapText Then
              RH = .Cells(j, n).RowHeight
              .Cells(j, n).EntireRow.AutoFit
              If .Cells(j, n).RowHeight < RH Then _
                .Cells(j, n).RowHeight = RH
            End If
          End If
        Next
      End If
    End If
  Next
  .Parent.Parent.Worksheets(.Parent.Name).UsedRange
End With
End Sub

 

[jann6628]

Sorry. It doesn't work.

You can try by merging A1, B1 and C1.

And then insert:

hey1
hey2
hey3
hey4
hey5
hey6
hey7


Excel will only show "hey1"

 

[MARK858]

Merging A2,B2 & B2 (because that is what the code is written for) and copying your data into the cells, then checking that wrap text is still ticked and running the code then I get the below...

 

[jann6628]

thats weird. In my example it doesn't work?