You’ve most likely heard this warning — “Avoid merged cells in your Excel worksheets!”, and that is excellent advice. Merged cells can cause problems, especially when they’re in a table that you’ll be sorting and filtering. You’ll run into more problems if you try to autofit merged cell row height.
Forced to Merge
Occasionally though, you might have no choice but to use one or more merged cells on a worksheet. As long as you avoid merging table cells, and proceed with caution, things might be okay.
In the example shown below, there is an order form, and space for a note about the order. If the note will always be short, there’s no need to merge the cells – just let the text flow across the columns.
However, if the notes will be two or more lines, you’ll need to merge the cells, and turn on Wrap Text. Adjusting the column width would affect the product list that starts in row 12, so that’s not an option.
Merged Cell Row Height
Usually, if you add more text to a single cell, and Wrap Text is turned on, the row height automatically adjusts, to fit the text.
When the cells are merged in row 10, the row height has to be manually adjusted when the text changes. That works well, as long as you remember to do it, but it can be a nuisance, if the text changes frequently.
And if you forget to adjust the row height, you might print the order form, while key instructions are hidden.
AutoFit Merged Cell Row Height
To fix the worksheet, so the merged cells adjust automatically, you can add event code to the worksheet.
[Update: The original code is below, and there are several modified versions of the code in the comments. There is also an updated version of Smallman’s code in this December 2015 blog post.]
The merged cells are named OrderNote, and that name will be referenced in the event code.
Code to AutoFit Merged Cell Row Height
We want the row height to adjust if the OrderNote range is changed, so we’ll add code to the Worksheet_Change event.
The code that I use is based on an old Excel newsgroup example, that was posted by Excel MVP, Jim Rech.
Note: As Jeff Weir pointed out in the comments below, this code will wipe out the Undo stack, so you won’t be able to undo any steps you’ve previously taken. So, instead of using the Worksheet_Change event, you could use the workbook’s BeforePrint event, to reduce the Undo problem.
- Right-click on the sheet tab, and paste the following code on the worksheet module. Note: Only one Worksheet_Change event is allowed in each worksheet module.
- Change the range name from “OrderNote”, to the named range on your worksheet.
- If your worksheet is protected, you can add code to unprotect and protect the worksheet.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MergeWidth As Single
Dim cM As Range
Dim AutoFitRng As Range
Dim CWidth As Double
Dim NewRowHt As Double
Dim str01 As String
str01 = "OrderNote"
If Not Intersect(Target, Range(str01)) Is Nothing Then
Application.ScreenUpdating = False
On Error Resume Next
Set AutoFitRng = Range(Range(str01).MergeArea.Address)
With AutoFitRng
.MergeCells = False
CWidth = .Cells(1).ColumnWidth
MergeWidth = 0
For Each cM In AutoFitRng
cM.WrapText = True
MergeWidth = cM.ColumnWidth + MergeWidth
Next
'small adjustment to temporary width
MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
.Cells(1).ColumnWidth = MergeWidth
.EntireRow.AutoFit
NewRowHt = .RowHeight
.Cells(1).ColumnWidth = CWidth
.MergeCells = True
.RowHeight = NewRowHt
End With
Application.ScreenUpdating = True
End If
End Sub
How It Works
The event code checks to see if the changed cell is in the OrderNote range. If it is, the code runs, and does the following:
- Unmerge the cells
- Get the width of the first column in the OrderNote range
- Get the total width for all columns in the OrderNote range
- Add a little extra to the calculated width
- Set the first column to the calculated total width
- Autofit the row, based on the note next in the first column
- Get the new row height
- Change the first column to its original width
- Merge the cells
- Set the row height to the new height
Screen updating is turned off while the code runs, and it all happens in the blink of an eye.
Test the Event Code
To test the code, make a change to the text in the named merged cells, then press Enter. The row height should adjust automatically.
Is this code, to AutoFit merged cell row height, something that you’ll use in your workbooks? Please let me know in the comments.
__________________
Hi Webber
Thanks for your kindly comments. Have a look at the post with the following date.
February 27, 2015 at 8:35 pm
I get quite animated. This code is fully flexible and will autofit cells on an entire sheet. There is a link to my site with a sample file. You could look at that for inspiration. If you fail to get it working email me your file and I will make it work for you. Email is on my site too.
All the very best
Smallman
Thanks Smallman, your website is very helpful!
I actually noticed the problem I was having shortly after the post. After I changed “With c” to “With Selection” all the irritating white space was gone!
Hey Smallman,
I feel like I’m so close, yet so far. I want this two work for two merged cells but just can’t seem to get it. These cells need to be unlocked so that people can enter text, but I don’t want to have to unlock the whole sheet (since there are other locked cells), and I don’t want them to have to put a password in. Is this possible? Your original code seemed to require me to unlock everything, so I tried:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vNewHeight As Single
If Target.WrapText = True Then
With Target
.Select
.RowHeight = 1
.WrapText = True
.UnMerge
.EntireRow.AutoFit
Selection.Merge
vNewHeight = .Width * .Height / Selection.Width
If vNewHeight < 16 Then vNewHeight = 16
.RowHeight = vNewHeight
.VerticalAlignment = xlCenter
End With
End If
End Sub
Unfortunately this gave me an "unable to set the rowheight property of range class" error. Long story short I'm stuck and would appreciate your help immensely!
Thanks,
River
Hi River
Sorry for the slow reply – I have been on the road and get little net time in that situation. I think there are heaps of examples in this thread of merged cells with protection. Just make sure that the 2 cells are “unlocked” before you apply this code to the worksheet module.
It should go pretty well. Give me a shout to my email address and I will send you a copy of a working file with 2 cells, unlocked and humming using this method. Here is an example of the coding.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vNewHeight As Single
ActiveSheet.Unprotect
If Target.WrapText = True Then
With Target
.Select
.RowHeight = 1
.WrapText = True
.UnMerge
.EntireRow.AutoFit
Selection.Merge
vNewHeight = .Width * .Height / Selection.Width
If vNewHeight < 16 Then vNewHeight = 16
.RowHeight = vNewHeight
.VerticalAlignment = xlCenter
End With
End If
ActiveSheet.Protect
End Sub
Take it easy River
Smallman
Hi Smallman
I have sent you an email with a help request. Just posting this here in the hope that you receive a notification or something.
Thanks
Wow!! Ya’ll are amazing!!!Thank you so much. If you could please help me with this. I used this and it works great, but have to run macros every time I make a change. So I tried the one at the bottom. However, I REALLY don’t know what I’m doing and I don’t know where to put the last one. I tried several different places, but it does not work. I would so appreciate any help.
Option Explicit
Option Base 1
Sub FixMerged()
Dim mw As Single
Dim cM As Range
Dim rng As Range
Dim cw As Double
Dim rwht As Double
Dim ar As Variant
Dim i As Integer
Application.ScreenUpdating = False
ar = Array(“K38”, “L38”, “M38”, “N38”, “O38”, “P38”, “Q38”, “R38”, “S38”)
For i = 1 To UBound(ar)
On Error Resume Next
Set rng = Range(Range(ar(i)).MergeArea.Address)
With rng
.MergeCells = False
cw = .Cells(1).ColumnWidth
mw = 0
For Each cM In rng
cM.WrapText = True
mw = cM.ColumnWidth + mw
Next
mw = mw + rng.Cells.Count * 0.66
.Cells(1).ColumnWidth = mw
.EntireRow.AutoFit
rwht = .RowHeight
.Cells(1).ColumnWidth = cw
.MergeCells = True
.RowHeight = rwht
End With
Next i
Application.ScreenUpdating = True
End Sub
Option Explicit
Private Sub Worksheet_Change
If Not Intersect(Target, Range(“K36, L36, M36,N35, O36, P36, Q36, R36, S36,”)) Is Nothing Then
FixMerged
End If
End Sub
Again, Thank you. I went back and re-read the whole thread and found the answer.
Thanks!!!
Hi All
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.
http://www.thesmallman.com/#!autofit-merged-cells/c10bs
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 SubTake care
Smallman
Smallman,
I am kind of a novice at this and I am having trouble. I have multiple rows that that need to resize and I need to add the sheet un-protect and protect functions to this. I am also having a problem with a couple of the cells not expanding enough, do I need to adjust the range on this one?
Smallman, I read through the thread and downloaded your file to witness it works but all discussions are around merged cells within a row what about the merged range spans to multiple rows in addition to merged columns?