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.
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.
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.
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