AutoFit Merged Cells Row Height Update 20151203

Way back in June 2012, I posted some sample code for adjusting the row height in merged cells. It’s been 3-1/2 years, and people are still commenting on that article!

Apparently it is a common problem, and even though I don’t like merged cells, sometimes we just have to deal with them.

AutoFit Merged Cells in Excel http://blog.contextures.com/

The AutoFit Problem

To quickly summarize the problem – if cells are merged, the rows don’t AutoFit correctly when you double-click in the row button area.

For example, the text doesn’t fit in the merged cell below.

mergedcellsautofit01

When I double-click the line between row buttons 10 and 11, the row height is reduced to fit one line of text, instead of expanding to fit all 3 lines of text.

mergedcellsautofit02

To show the full note in the merged cell, I have to manually adjust the row height.

That’s why I created a macro to automatically adjust the row height for merged cells.

Help With Questions

Throughout the comments in the original blog post, Smallman has answered many questions, and adjusted the code to meet new requirements, such as multiple merged ranges on a worksheet. Thanks Smallman!

Recently, he posted a new version of the code, and included a link where you can download his sample file. To make the code easier to find, I’ve put it in this update article, so it isn’t buried in the comments!

Notes on Using the Code

Warning: Like other macros that change the worksheet, this code will wipe out the Undo stack, so you won’t be able to undo any steps you’ve previously taken. If other people will be using the code, let them know about this!

In the original example, the code ran when the Order Form Note was changed – that triggered the Worksheet_Change event. You could use the workbook’s BeforePrint event, to reduce the Undo problem. Or, use a button on the worksheet, like the one in Smallman’s sample file.

Also, if your worksheet is protected, you can add code to unprotect and protect the worksheet.

Improved AutoFit Merged Cells Code

Below is Smallman’s code, and his description of what the code does. I wrapped some of the lines, to make it fit better in the blog post. If you download his sample file, the code will look a bit different.

Go to the AutoFit Merged Cells with VBA page on Smallman’s site, to download his sample file.

From Smallman’s comment on the original article:

I have been working on a problem which has been raised quite a bit in this blog regarding the problem of when you have multiple merged cells in the same line. Nothing to date has dealt with this problem and I think I have an answer. The following will look at all cells in a given line and work out which cell has the ‘most’ text. It will then make that cell the big daddy and it will dictate how tall the row height is for the entire row.

For those interested in an example I put a new tab in the workbook on my own site as I can’t upload files here. It works nicely. The tab which performs the magic is the red one at the end. Here is the coding for those interested.

‘—————————–

Option Explicit

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 = Range("C10:O" & _
  Range("C" & Rows.Count).End(xlUp).Row)

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

_________________________

AutoFit Merged Cells in Excel http://blog.contextures.com/

3 thoughts on “AutoFit Merged Cells Row Height Update 20151203”

    1. I was using this code and it helped greatly. Thank you very much.

      One bug I found is that if my source font is different (bigger), the spare column is not using its source font and hence when adjusting the row height, its not correctly doing it because its trying to autofit row height on a smaller font text which can fit in the given width. I had to modify this code to copy the font from the source field to the spare column which fixed the issue. Posting the code below for others who may need this.

      With .Parent.Cells(.Row, SpareCol)
      .Value = rngMArea.Value
      .ColumnWidth = MW
      .WrapText = True
      .Font = rngMArea.Font
      .EntireRow.AutoFit
      RH = .RowHeight
      MaxRH = Application.Max(RH, MaxRH)
      .Value = vbNullString
      .WrapText = False
      .ColumnWidth = 8.43
      .Font.Name = “Calibri”
      .Font.Size = 11
      End With

  1. Good morning,
    the code you posted is exactly what I need and it works fine… till a certain row…
    I modified the code to get a certain range automatically (with two counters). The rng variable is set to something like H3:K3387. The problem is that at row 989 the code stops working… This row contains a two line text which instead of being set at 27 (36 pixel) height is set to 25.5 (34 pixel); after this row the code simply doesn’t work anymore.
    Any help or idea?
    Thanks,
    m.

Leave a Reply

Your email address will not be published.

This site uses Akismet to reduce spam. Learn how your comment data is processed.