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.
__________________
OMG, genius. I don’t normally work with named ranges so this was a total experiment for me (but extremely necessary as I’ve built an application form that *needs* the merged cells to autofit). No one could have been more surprised than I when, with trepidation, I named a range, stumbled into visual basic, pasted the formula, replaced the named range with my own and it worked. Thank you thank you thank you!!
However … I also have the same issue as Rick and Kris, in that I have multiple instances (to be specific, eight) on a particular tab that need this same treatment, I have yet to see anyone address how to resolve this. I have copied and pasted the formula, updated the named ranges but am getting the following error: “compile error: ambiguous name detected – worksheet_change”- thanks for any light you can shed.
I’m foreign, no, alien to programming. So the stuff that I saw here, I just copied and pasted onto my excel but I do not know how to run it or do anything to trigger it. Can someone post a video on youtube how to do the coding for different scenarios? That would really help me as it is driving me crazy to align 150 lines by hand everytime a new piece of work comes in
Hi, the codes above work great! Thanks a million. How do you get the code to work if the merged cell has a formula which pulls from another sheet?
I got it to work never mind!!! 🙂
Another question though, my excel worksheet acts as a mail merge using the following code and it works like a charm! This macro is run by a button to print preview all the letters in the range.
Sub PreviewLetters()
Dim StartRow As Integer
Dim EndRow As Integer
Dim Msg As String
Dim i As Integer
Sheets(“LetterTemplate”).Activate
StartRow = Range(“StartRow”)
EndRow = Range(“EndRow”)
If StartRow > EndRow Then
Msg = “ERROR” & vbCrLf & “The starting row must be less than the ending row!”
MsgBox Msg, vbCritical, APPNAME
End If
For i = StartRow To EndRow
Range(“RowIndex”) = i
If Range(“Preview”) Then
ActiveSheet.PrintPreview
Else
ActiveSheet.PrintOut
End If
Next i
End Sub
My problem is, I want the cells to auto fit the contents of one of the merged cells in the letter but I am not sure how to combine the two to give me what i need. This is the code that runs to autofit to the contents (thanks to you guys!)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
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
Set KeyCells = Range(“E5”)
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Application.ScreenUpdating = False
‘Cell Ranges below, change to suit.
ar = Array(“C25”, “F27”)
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
.Cells(1).ColumnWidth = mw
.EntireRow.AutoFit
rwht = .RowHeight + 5
.Cells(1).ColumnWidth = cw
.MergeCells = True
.RowHeight = rwht
End With
Next i
Application.ScreenUpdating = True
ActiveSheet.PrintPreview
End If
End Sub
What do i need to do to run the mail merge and the Cells C25 and C27 changes to fit the contents?
Oh my never mind i got it! I left this part of the code in the worksheet module
Public Const APPNAME As String = “Marsha”
Option Explicit
Sub PreviewLetters()
Dim StartRow As Integer
Dim EndRow As Integer
Dim Msg As String
Dim r As Integer
Sheets(“LetterTemplate”).Activate
StartRow = Range(“StartRow”)
EndRow = Range(“EndRow”)
If StartRow > EndRow Then
Msg = “ERROR” & vbCrLf & “The starting row must be less than the ending row!”
MsgBox Msg, vbCritical, APPNAME
End If
For r = StartRow To EndRow
Range(“RowIndex”) = r
ActiveSheet.PrintPreview
Next r
End Sub
And I placed this in in the worksheet change event:
Option Explicit
Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
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
Set KeyCells = Range(“E5”)
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Application.ScreenUpdating = False
‘Cell Ranges below, change to suit.
ar = Array(“D24”)
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
.Cells(1).ColumnWidth = mw
.EntireRow.AutoFit
rwht = .RowHeight + 6
.Cells(1).ColumnWidth = cw
.MergeCells = True
.RowHeight = rwht
End With
Next i
Application.ScreenUpdating = True
End If
End Sub
Hi All
This thread had been closed for a while but now seems to be reopened. I have created a file on my own website which outlines 3 different methods outlined in this blog. The file can be found on my site here.
http://www.thesmallman.com/#!autofit-merged-cells/c10bs
The file should help people who are not familiar with VBA to visualise how this technique works.
Take care
Smallman