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.
__________________
This is what I ended up doing. I can’t remember how I got here but it was definitely from this page. It works beautifully. If there is an easier way to list the cells in the array rather than one by one, that would be a great bonus.
Option ExplicitOption 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
'Cell Ranges below, change to suit.
ar = Array("D20", "D21", "D22", "D23", "D24", "D25", "D26", "D27", "D28", "D29", "D30", "D31", "D32", "D33", "D34", "D35", "D36", "D37", "D38", "D39", "D40", "D41", "D42", "D43", "D44", "D45", "D46", "D47", "D48", "D49", "D50", "D51", "D52")
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
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("C5")) Is Nothing Then Sheet4.FixMerged
End Sub
Hi Meridith
Your range is sequential which is really convenient. I would dispense with the Variant. The array Variant (ar) was set up as the example was a non-continuous range of cells. So set up a named range in Cell D52 or your last merged cell. Then you can use the following to procedure to fix the merged cells.
Take care
Smallman
Option Explicit 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 For i = 20 To Range("Lr").Row On Error Resume Next Set rng = Range(Range("D" & 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 SubWhat would be the “code” for “Automatically Adjust Row Height” that Debra posted back on June 7th, 2012? I used the code provided by Smallman on March 23, 2013 at 11:01 pm to adjust “several” merged cells in one of my working files. The code works well, BUT I have to click “Run Macro.” After I click “run macro,” all the cells listed within the “Array” adjust to the necessary height to show the text. This is what I have:
Option ExplicitOption 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("A25", "A27", "A29", "A31", "A33", "A35", "A37", "A39", "A41", "A43", "A45", "A47", "A49", "A51")
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
_______________________________
What do I need to do to make EACH AND ALL of the merged cells adjust AUTOMATICALLY every time I change (add/delete) text from the cells without having to run the macro manually?
Note: I am not a programmer. I am grateful for all the time you dedicate to help and share your knowledge.
Thank you.
Hi Roberto
If you add a worksheet change event to the sheet where your merged cells exist you should be able to run the macro when each cell changes. Give the following a try in the worksheet object where the merged cells live 🙂
Take care
Smallman
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range(“A25, A27, A29, A31, A33, A35, A37, A39, A41, A43, A45, A47, A49, A51”)) Is Nothing Then
FixMerged
End If
End Sub
Hi,
Following these instructions gets me to this error:
“Compile Error:
Wrong number of arguments or invalid property assignment”
Here is what I have for the code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range(“C2”, “C3”, “H4”, “C5”)) Is Nothing Then
FixMerged
End If
End Sub
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(“C2”, “C3”, “H4”, “C5”)
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
—
I have been at it for hours and have read and reread the posts here but cant get past this issue.
Thanks for you help!!!
Hi Dave
Email me your workbook and I will have a look at it for you.
You can email me at MarcusSmallATTLESthesmallman.com
Where ATTLES is the @ symbol.
Take care
Smallman
Thanks so much for looking into this. I sent you the file. I was able to get rid of the compile error by following Rick Rothstein’s advice but now I am stuck with cell C2 not auto expanding.
You should have told us which line of code the error displayed at. My bet is this one…
If Not Intersect(Target, Range("C2", "C3", "H4", "C5")) Is Nothing ThenThe Range object cannot take more than two arguments… you gave it four. I think what you want for this line of code is this…
If Not Intersect(Target, Range("C2,C3,H4,C5")) Is Nothing ThenThat was it! No more compile error but the auto height is not working on Cell C2. Works on all the others (C3, H4 and C5) but just not on C2.
Latest Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range(“C2,C3,H4,C5”)) Is Nothing Then
FixMerged
End If
End Sub
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(“C2”, “C3”, “H4”, “C5”)
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
Hi Dave
Excellent news. To solve your next problem in the FixMergedCells procedure you will notice in the thread 2 above the one you started there is a line at the top of the procedure;
Option Base 1
You did not copy this line. It starts the loop at 1 not 0. So if you add the line to the top of the procedure C2 will be fine.
Alternatively change this;
For i = 1 To UBound(ar)
To this;
For i = 0 To UBound(ar)
Should solve your current problem one way or the other.
Take care
Smallman
Smallman,
It works! Thank you for your kind and valuable response. You are indeed a very kind and knowledgeable person.
Thank you.
Hi Roberto
Thanks for your comments, much appreciated but I think the real heros of this post are Deb and the others who added to its organic growth. I just took the basic concept and enlarged it for a client of mine. I was so pleased with the result I then shared it with this forum as I felt indebted as I don’t think I would have come up with the idea all by myself. It is a really valuable tool. Thanks for coming back and commenting, at times you wonder how people got on. Good luck to you.
Take care
Smallman