AutoFit Merged Cell Row Height

AutoFit Merged Cell Row Height

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.

mergecellsautofit01

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.

mergecellsautofit02

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.

mergecellsautofit03

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.

  1. 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.
  2. Change the range name from “OrderNote”, to the named range on your worksheet.
  3. 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:

  1. Unmerge the cells
  2. Get the width of the first column in the OrderNote range
  3. Get the total width for all columns in the OrderNote range
  4. Add a little extra to the calculated width
  5. Set the first column to the calculated total width
  6. Autofit the row, based on the note next in the first column
  7. Get the new row height
  8. Change the first column to its original width
  9. Merge the cells
  10. 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.
__________________

135 thoughts on “AutoFit Merged Cell Row Height”

  1. Sweet idea. Couple of suggestions:
    1. Might pay to set out in the instructions above that this code is set up to work with a protected worksheet. So you need to make sure that any input cells (including the OrderNote range) are not locked – otherwise you will be locked out of them once the code runs. To do this, select all the input cells in the form, unlock the worksheet, push Ctrl + 1, and on the Protection tab of the Format Cells dialog box untick the “Locked” option.
    2. This code wipes out the undo stack. This could really annoy users if they have made a mistake, and want to change something (I had some annoyed users due to this very issue for a form I built some time back). Given that the stated purpose is to ensure instructions are printed, how about triggering it only when printed, via a Before_Print event? That way, the undo stack only gets wiped after Print is pushed.

  2. I am curious as to why you declared the “ws” variable, assigned the ActiveSheet to it and then used it as the object of the With statement? Since it is only two letters long, couldn’t you have avoided declaring the “ws” variable and, given that we are inside event code, simply used the two-letter long keyword “Me” for the object of the With statement instead? Given you did do it the way you did, why not remove the keyword “Me” from the calls to Protect and Unprotect and let their leading “dots” reference the With statement’s “ws” argument instead?
    As to the Protect/Unprotect issue, I guess it is possible for a worksheet to be protected except when run by an authorized individual who, through some set of macros and/or subroutines, unprotects the worksheet in an initializing macro and sets the protection back again in a log-off type macro… for that scenario, your code would leave the authorized user facing a protected sheet when there is still other macros and/or subroutines left to run all of which expect the protection to have still been lifted. To cater to this scenario (without burdening the normally expected setup), you could declare a Boolean variable, named say WasProtected to hold the worksheet’s ProtectContents property and then test that at the end to see if the sheet should have its protection turned back on. I’m thinking of something along these lines (which would leave the worksheet’s protection status at the conclusion of the code the way it found it at the beginning)…
    With Me
    WasProtected = .ProtectContents
    If WasProtected Then .Unprotect
    '
    ' Your current code goes here
    '
    If WasProtected Then .Protect
    End With

  3. Hej Debra,
    works great, but I am not able to understand why I need to add “small adjustment to temporary width”: MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66.
    What problem does that line solve?
    Thanks,
    Johan

    1. @Johan, that adjustment is the result of my testing, and without it, extra height is often added to the cell. By adding a bit to the width, the row height autofits correctly.
      It’s similar to those cells you might have encountered — it looks like everything fits across, but when you try to autofit the row, Excel adds an extra blank line.

  4. Hi Debra,
    in my previous post on September 22, I was looking to understand why you have decided to do the mentioned adjustment to the width. This is still unclear to me.
    What I have discovered now is however more important. Your code works fine in Normal view, and all lines become visible, but when I switch to Layout or Page Break view, some of the rows are again invisible, and the code does not change that fact in those views. Also when I print, the lines are not visible. So I thought the code solved the problem, but while the code works perfectly in Normal view and on the screen, in the other views and when printing not all lines are visible. Can this be solved?
    Would be very greatful for your comment.
    Thanks,
    Johan

  5. Johan,
    Great code. This solved a huge headache of mine. I would just like to echo John’s comment from June 7. I am using this in a form for a client so I would like to be able to protect the sheet, but when I do, two things happen: first, the merged cell gets oversized, then it gets locked. Any idea as to why this is happening?

  6. Hi Debra,
    This code is great, thanks for posting. Just one thing I discovered – it works fine if the cell just contains a value but, if it contains a formula displaying a value updated from another sheet, it doesn’t do the autofit.
    The solution is to add the following code to the Worksheet_Activate() event to force a recalulation:

    Range("OrderNote").Select
    ActiveCell.FormulaR1C1 = "='formula in OrderNote"
    ActiveCell.Calculate

  7. Say you have a sheet with merged cells (say two of them within range A2:A4), and they contain formulea that display values from other sheets, and those values may vary in length, you can have your merged cells auto-resize to fit the length of the values.
    Put this code on the on activate event of the sheet your merged cells are in:

    Private Sub Worksheet_Activate()
    Dim r, c As Range, strF As String
    Set r = Range("A2:A4")
    For Each c In r
    If c.MergeCells = True Then
    If c.HasFormula = True Then
    c.Select
    ReSizeRow
    End If
    End If
    Next
    End Sub

    And this code in a module:

    Public Sub ReSizeRow()
    With ActiveCell
    .WrapText = True
    .UnMerge
    Rows(.Row).AutoFit
    .RowHeight = .Width * .Height / Selection.Width
    Selection.Merge
    End With
    End Sub

    1. Ged,
      I have this issue with Excel for Mac 2011. I have a formula in a merged cell that pulls text data from another sheet. I would like the merged cell to resize it’s height based on the resulting text. None of the codes I have tried work. Nor the above codes. Any suggestions?
      Thanks!

  8. Hello. First, thank you for a very helpful post. My problem: I have more than one merged cell in my worksheet that I need to apply this too. How do I modify the VBA code above to include more than one “OrderNote”??? Thank you.

  9. I have the same issue as Rick which was posted on Nov. 30. I have multiple merged cells on my worksheet and need to how to modify the code to include more than one “ordernote”. Thanks in advance for any insight on how to fix this.

  10. Your code is great! Thank you so much. I also have the same issue as Rick (posted on Nov 30.) I have several merged note cells in one worksheet. How do you modify the code to include more than one merged note cell? Thank you very much for your help with this.

  11. This is great! But I also having the same issue with having multiple merged cells in the same worksheet. How can the code be modified to include more than one Named Range? Thank you!

  12. Hi
    I have been on this website countless times over the years. Deb should be congratulated for creating such a great forum for knowledge sharing. I had a friend ask me to crack this one for his company and I ended up on this page. I noticed the last three posts are looking for a solution for multiple merged cells. I altered the variables a bit and added the function for multiple cell ranges, which can be changed to suit your needs. Here is my take on the problem. It is to go in a regular module so you can run it at will.
    I could have included a working copy of the procedure if the site offered the ability to upload files.
    Take care
    Smallman

    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
    'Cell Ranges below, change to suit.
    ar = Array("C64", "C67", "C69", "C71", "C73", "C75")
    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
    1. Hi Smallman,
      You’re code is working perfectly for me! thanks! I have one more small request… How can I add a parameter somewhere that keeps the merged cells unlocked? My sheet is password protected and once I run this code, the merged cells become locked and I can no longer enter any data.
      Thanks in advance!
      Suzi

    2. first off i like to thank you finding this page has helped so much.
      but i do have some issues after impelmenting the code for the range of cells, the code only works by manually running the macros did i miss a step to have the code automatically adjust the size of the comment boxes once the user has left each cell in the range. Another issue is that the code shrinks the cells that have not yet have text added to them. is there a way to have the work book keep the formatting of all cells in the range if no text is entered.
      thanks
      Peter

  13. @Suzi: select the merged cells, then in the format cells dialog (which you can launch by pressing CTRL F1), select the Protection tab, then uncheck the Locked tickbox.

  14. Hi Suzi
    Thanks, pleased it works for you. I expect that you want to do this on the fly within the procedure you are currently running not manually. With the example above you could use something like the following within your procedure to unlock the cells in question. First unlock the sheet, then the cells, then lock the sheet up again. Hope it helps.
    Take care
    Smallman

    Option Explicit
    Sub UnLockRng()
        Dim rEntry As Range
        Sheet1.Unprotect 'Unprtotect sheet
        Set rEntry = Range("C64, C67, C69, C71, C73, C75")
        rEntry.Locked = False
        Sheet1.Protect 'Protect sheet
    End Sub
    1. Hi there. I am very, very novice at coding, and have no idea where to insert Smallman’s Option Explicit code (detailed above) into the main chunk of code that Jeff Weir laid out in his 2012 article (which works fine except it locks the cell after resizing, and I don’t want the cell locked). I am still running Excel 2010, and my spreadsheet has no password. I just protect, and unprotect, the sheet with the icon as it is a multi-user spreadsheet.

      I tried Jeff’s updated code at https://contexturesblog.com/archives/2015/12/03/autofit-merged-cells-row-height-update-20151203/ but I can’t get that code to work at all, so can only assume that this only works in later versions of Excel. I also tried the following code, but I couldn’t get that to work either:
      Private Sub Workbook_Open()
      Dim wSheetName As Worksheet
      For Each wSheetName In Worksheets
      wSheetName.Protect Password:=”Secret”, UserInterFaceOnly:=True
      Next wSheetname
      End Sub

      Can anyone advise where the Option Explicit code should sit?

  15. @Smallman: That code’s not needed if the cells are manually set to .Locked = false, as I suggest above.

  16. Either way, both methods work. What you suggest does not achieve a different result. Run the code once, or do it manually. Choices, isn’t that the point? Thanks for providing your input.
    Take care
    Smallman

  17. Yes I did mention that or did you miss that bit? It is just above in black and white.
    Take care
    Smallman

  18. Yes I did miss the bit where you said “Run this code only once”, because also above in “black and white” is your statement With the example above you could use something like the following within your procedure to unlock the cells in question.
    So if Suzi implemented your approach as you originally posted, then every nth time she runs her routine, your code addition does something that is not necessary.
    Even had you not said that above, I don’t understand why someone should run a macro one time to do something so trivial. To my mind, it’s a bit like suggesting a VBA approach when someone asks “How do I make Cell A2 bold”

  19. Hi Jeff and Smallman,
    I apologize for the delay in replying. I was pulled onto another small project…
    Anyway, I have read your posts and I understand how to unlock cells. This is a common routine used thoughout many forms I create.
    I believe I may have missed out a part in my initial request. I noticed this when I looked at the code again. It seems the problem is happening because there are named ranges.
    In the Array, rather than using cell names (i.e. C23, C24), I used named ranges. I have pasted my code below. The code works great but even though going into the code the cells are unlocked, by the time it finishes, the cells are locked up. I hope this helps. let me know if you need further clarifications. Thanks!

    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
    ActiveSheet.Unprotect "password" ', userinterfaceonly:=True
    Application.ScreenUpdating = False
     'Cell Ranges below, change to suit.
     ar = Array("RAFDesc", "Summary", "AssExcRisks")
     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
    ActiveSheet.Protect "password"
     End Sub
  20. Hi Suzi
    Welcome back. That was quite a break.
    Before you protect your sheet you will need to unlock the cells in your named ranges. So in the lines before the protect statement include something like the following;
    Range(“C47:J47”).Locked = False
    Do this for each of your 3 named ranges. This will give you the restult you want.
    Take care
    Smallman

    1. Hi Smallman! Everything is working fabulously! I was so close when I testing prior to my reply… I was trying to unlock the named ranges rather than the range of cells.DOH!! Thanks again! You have been invaluable!
      Regards, Suzi

  21. Hi Suzi
    It becomes a little more complex when working with named ranges to unlock the cells. On testing I assumed your named ranges were 1 cell in length, from here you merged the cells. What you have to do is cycle through all of the merged cells and unlock them one at a time. Add the following to your code and it will unlock the cells of your named ranges. I would refer to this procedure just before you add the sheet protect button or just copy everything under the Sub line and before the End Sub line.
    I have put the following in as a stand alone procedure. I hope you will be pointed in the right direction from here.
    Take care
    Smallman
    Option Explicit
    Option Base 1
    Sub UnLockIt()
    Dim arr As Variant
    Dim r As Range
    Dim i As Integer
    arr = Array("RafDesc", "AssExcRisks", "Summary")
    For i = 1 To UBound(arr)
    For Each r In Range(arr(i))
    r.MergeArea.Locked = False
    Next r
    Next i
    End Sub

    1. Hi Smallman, where does this go in the context of the larger chunk code? I can’t get this to work because I don’t know where the “Option Explicit” part goes… I have tried it at the end before End Sub, and as a separate thing, but neither works. I get an error message, a compile error: “Invalid inside procedure”. Can you help?

  22. Brilliant! Thanks Debra! I’ve been trying to figure this out for a couple months now! Thanks again!

  23. First, I want to sincerely thank Debra and others who have provided this very helpful code. It resolved an issue I’ve had with a spreadsheet for some time. I am more of an analyst and not programmer, but find this process somewhat interesting and would like to know a little more about how this works.
    I find that when I use this merged cell resizing code in a fairly complex worksheet (actually multiple sheets within a workbook) which includes password protection, that everytime I make a change to any cells in the worksheet, the ActiveSheet.Protect statement “re-protects” my sheet.
    Is there an easy way to change the original code so that it will only resize with a change to the “OrderNote” cell? This would allow me to make changes to the template without it always going back to protected status.
    Thanks
    Chuck

  24. Hi,
    I used the code successfully on one merged cell but have 7 more on the same tab. I see it only works once per tab, but there was some discussion about applying to more than one and I couldn’t understand the posts completely (not technical at all!!. If there is one that has the code for this would you mind telling me the date and name of person who posted.
    Thanks,

    1. Hi Waveney
      There are plenty of examples on this page of using this code with mulple cells. If you read the posts beneath you will see code for continuous and non continuous ranges of cells. Hope this helps.
      Take care
      Smallman

  25. I am completely new with working in VBA and am having no luck getting this to work for me. I’m trying to create a workbook that creates a report (one worksheet formatted for printing) by pulling in information (via formulas) from other worksheets. The report is “generated” when a name is selected in a drop down menu, directed all the formulas to pull information based on that name. Part of the report is to populate merged cells with “notes” entered in a log from a different worksheet. Some of the notes are 3 or 4 lines long and would need to change the height of the row. I think I’m in the right place to automate this but I can’t seem to get it to work. In the notes section of the workbook, the rows go as followed (row 1) Date: (row 2) Type: (row 3) Notes: . Can someone give me a step by step instructions? Any help is greatly appreciated for this VBA beginner who loves Excel.

  26. The whole comment didn’t post because I used brackets for part. The rows go as follows:
    Row 1 – Date: (formula)
    Row 2 – Type: (formula)
    Row 3 – Notes: (formula in merged cells B3:G3) – this is the cells I want to auto adjust the height.
    Thank you again.

  27. Depending on your situation, this may actually be solvable without additional code. This is especially the case if you are delivering a printout or PDF instead of the Excel file itself.
    Here’s an example:
    Let’s say you’ve got a print area of columns A->E, and your merged cells are in columns C-E, with a combined width of 90.
    All you have to do is set aside an unprinted column, width 90, with wordwrap on. For this example let’s say you can use column I. Then whenever you write a value to cell B#, write the same value to I#. The single cell in column I will then trigger the autoheight. And it will not show in printing. If your end user receives the excel file and you don’t want this second value to show, you can use a cell far to the right and set the font to white. Unlike charts, it won’t matter if your user finds the value – all they can do is damage the auto-height.

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

  29. 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 Sub
  30. What 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 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("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.

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

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

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

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

      3. 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 Then
        The 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 Then

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

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

  32. Smallman,
    It works! Thank you for your kind and valuable response. You are indeed a very kind and knowledgeable person.
    Thank you.

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

  34. Smallman, I have been following this thread, trying as everyone else to solve this problem, I have a huge range of cells, 86 in total, and each is merged across from I-L, if i am using the attached code in the Worksheet_Change I get a Compile error: wrong number of arguements or invalid property assignment. Any idea why?
    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range(“I4”, “I5”, “I6”, “I7”, “I8”, “I9”, “I10”, “I11”, “I12”, “I13”, “I14”, “I15”, “I16”, “I17”, “I18”, “I19”, “I20”, “I21”, “I22”, “I23”, “I24”, “I25”, “I26”, “I27”, “I28”, “I29”, “I30”, “I31”, “I32”, “I33”, “I34”, “I36”, “I37”, “I38”, “I39”, “I40”, “I41”, “I42”, “I43”, “I44”, “I45”, “I46”, “I47”, “I48”, “I49”, “I50”, “I51”, “I52”, “I53”, “I54”, “I55”, “I56”, “I57”, “I58”, “I60”, “I61”, “I62”, “I63”, “I64”, “I65”, “I66”, “I67”, “I68”, “I69”, “I70”, “I71”, “I72”, “I73”, “I74”, “I75”, “I76”, “I77”, “I78”, “I79”, “I80”, “I81”, “I82”, “I83”, “I84”, “I85”, “I86”)) Is Nothing Then
    FixMerged
    End If
    End Sub

  35. Hi Dan
    How are things other than your current conundrum. One of the reasons the range has been set out one by one in prior posts is because the data is not sequential. Your data is wonderfully sequential which means you can shorten your code and you should get a result. The shortened code would look like this.
    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range(“I4:I86”)) Is Nothing Then
    FixMerged
    End If
    End Sub
    This will fire the code FixMerged whenever a cell between I4 and I 86 is changed. Hope this points you in the right direction and you get the result you are after.
    Take care
    Smallman

  36. Hi Deb and Smallman
    I key monthly data in a central location and use a vlookup to populate the comments field.
    I see reference to unprotecting sheets and protecting again at the end. I have a further complication. My workbook is also shared. Additionally I quite often find that there is so much text that after a certain point (255 characters I assume) that text wrapping ceases to work. I need to go back to my source data and put carriage returns in.
    To protect/unprotect the sheet sharing needs to be off. Is there a way to add this as a function in the macro or is that a dangerous concept if others are using the sheet?
    Do you know of any solution that would enable the text to continue wrapping no matter the length?

  37. First off, thanks everyone for the comments. It’s helped me enormously. I do have one issue however. I’ve used your code Smallman to autofit within a range (columns C to E) while also using the range option vs. array (about 100 of them C10:C100), but here’s the dilemma: I also have a second set of merged cells on the same sheet (columns F to H – 100 rows) that I want to use this code on. What happen of course is that when one merged cell range is autofitting (columns C to E), it affects the other merged cells – meaning the data gets “hidden” in cases where there’s more information within. (Vise versa as well).
    I’m looking for a way to check to make sure that if the first set of merged cells requires to be autofitted (say within merged cell C50), then it checks to make sure that it ALSO takes into account merged cell F50, and only autofits to the “larger” of the two. Make sense?
    Couple assumptions here: I’m assuming the code is limited to only one merged cell set by column. I’ve also tried to use a named cell across both columns with merged cells and that failed understandably.
    Note: I’m an old programmer (been years since I’ve coded so think of me as a beginner)! Thanks again for all the help.
    Chris

  38. Hi Doctorhifi
    I don’t believe you can get around this issue. It seems when you run an altering macro in XL, you lose the capacity to Undo.
    Take care
    Smallman

  39. Hi Chris
    I am sorry for the late reply. I usually get an email response when someone posts in this thread which has not occurred. I did some testing with Col F larger (more characters) than Col C where I only use the code on Col C. The code seems to adjust for the larger Col F when deciding on the size of Col C. In short it looks to be working well at my end.
    Take care
    Smallman

  40. Hello Deb and Smallman,
    Thank you for this excellent procedure. Smallman, could share a working copy of the procedure by uploading it to dropbox and providing a download link? I’ve tried your procedures on an unlocked document with a sequential range and the data coming from another sheet using a lookup formula. I have not been able to make it work after following the entire thread.
    Thanks!
    Noel

  41. Hi Noel
    I will upload a working file to a file sharing website. That is a cracking idea and I am sorry I had not thought of it.
    Well done. Should appear in the next day or so.
    Take care
    Smallman

    1. Thanks Smallman. So I finally have your procedure working using “Private Sub Worksheet_Change(ByVal Target As Range)” to trigger the “FixMerged” macro. The only issue I’m having now is that the macro takes approximately 8 to 10 seconds to complete the procedure. I should mention there are many if statements in the worksheet change event that I use to show/hide rows and “select case” to clearcontents in certain cells. Is there a way to have the the worksheet change event only trigger the “FixMerged” macro without running through all the other if statements to speed up your procedure? Many thanks!

  42. Hi Noel
    Thanks for getting back to me. I did not get round to posting the link to my file sharing site last night but will do it tonight. I see from the procedure that the screenupdating is turned off. Have you thought to turn the calculations off while the procedure runs. They are not really necessary for a merging of cells. You may have other events in the background that are slowing down the run times. So you can disable events.
    ‘This at the start of the procedure
    Application.Calculation.xlManual
    Application.EnableEvents = False
    ‘This at the end of the procedure
    Application.Calculation.xlAutomatic
    Application.EnableEvents = True
    Hope this helps and I promise to upload a file shortly.
    Take care
    Smallman

  43. Thanks Smallman. I added your suggested code at the beginning and end of the procedure, but receieved compile error “Invalid qualifier”. This error goes away if I remove the Application.Calculation.xlManual and Application.Calculation.xlAutomatic. Thanks again for your assistance.
    Noel

  44. Hi Noel
    Sorry, I just hard coded that into the forum from memory. The exact syntax is;
    Application.Calculation = xlManual
    Application.Calculation = xlAutomatic
    Sorry for stuffingg you around.
    Take care
    Smallman

  45. Hi All
    I have finally got round to loading a file which incorporates some of the above. Seeing is believing and I hope the file helps show some of the theory above in a practical environment.
    https://rapidshare.com/share/3C2165E05831B15C225E7BD16FF4EE23?bin=1
    I have included 3 scenarios. One non Sequential Range, one sequential range and One OnChange Sheet which will update when the cells in Column C Change.
    My file sharing website recently changed the way you share data so if the following does not work can someone, anyone, sing out and I will try again. If Rapidshare asks if you want to open an account just hit Cancel if you don’t want an account. GoodLuckski!!!
    Take Care
    Smallman

    1. Smallman,
      I read through all of these comments, and find that I have a slightly different issue. I have a set of 4 consecutive ranges (G20:g71,k20:k71,v20:v71,z20:z71), so when I tried to use the code that you share in this rapidshare example file, I found that I could only run it for one range at a time. If I tried to change “Set rng = Range(Range(“G” & i).MergeArea.Address)” to accommodate more than one range, then it merged them together. If I copied:
      For i = 20 To Range(“g71”).Row
      On Error Resume Next
      Set rng = Range(Range(“G” & 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
      and then changed the range from G to K, it only ran the second range.
      I tried the other code you have above from 4/29/2013 but that doesn’t work at all (whereas this one does). I can confirm that wrap text is on, cells are merged, and the ranges are each named.
      Any ideas about how I can pull this off?
      Another issue I have is that I don’t want this to empty my undo cache every time it runs. I read somewhere else that the workbook beforeprint event only empties the undo cache at time of printing, but otherwise works like worksheet change. Do you have any wisdom for me there?
      Thank you for any help you can give.
      Patrick

  46. Hello everyone,
    I see a lot of very bright minds on here, and I understand absolutely NOTHING to codes… Reading this post with all the suggestions that seem to work for others felt like reading an ancient foreign language to me… I was wondering if someone would be so kind to give a step by step almost of how to enter the code? I need to adjust row height automatically on merged cells, whose content are coming from a vlookup formula getting the data from another worksheet. The codes I have tried here make fully disappear the rows my cells are in, when they do something… I have tried the first initial suggestion, but have no idea how to “add” the additional code and module suggested by Ged Warren.
    Thank you all for your contribution!
    Cheers
    Christine

  47. Hi Christine
    I know this sort of thing can be difficult if you are new to it. Did you try downloading the file above? Patrick managed to download it. Working examples are helpful if there is a practical spin on it and the file should mean that all you have to change in the range which is relevant to your problem. The file has an example of a sheet which changes the merged cells so it auto-fits whenever the typing is finished in that cell.
    It works for most of the people above because the coding is sound. If you could download the file and play around with this line in the code if you have single cells;
    ar = Array(“C5”, “C7”, “C9”, “C11”, “C13”, “C15”)
    If you have a range of cells then the file deals with that too.
    Post back if you need further assistance.
    Take care
    Smallman

  48. Hi Patrick
    You could run a loop outside of your loop for all 4 ranges. You do know that you will be bound within the row but the cell which has the largest amount of text in it. That is to say that the other cells in for exaple Row 20 will all be resized to the largest amount of text in the row. Have a play with the following. I am going to attempt to use Code tags in this thread for the first time and you can not go back and edit posts once made so if the [code] appears at the start of the code just ignore it. I am trying to get some indenting in my code which is sadly missing.

    Sub FixMergedRng()
    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
    Dim j As Integer
    Application.ScreenUpdating = False
    'Cell Ranges below, change to suit.
    ar = Array("G71", "K71", "V71", "Z71")
        For j = 0 To UBound(ar)
            For i = 20 To Range(ar(j)).Row
        On Error Resume Next
        Set rng = Range(Range("C" & 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
    Next j
    Application.ScreenUpdating = True
    End Sub

    For your second issue you can’t make the Undo come back after you have run a macro. It clears the memory. So you need to be careful how you use the coding.
    Hope this helps.
    Take care
    Smallman

  49. Hi Noel
    I just clicked on the link without even logging in and I managed to download the file. It should work without issue. If anyone wants to comment on the ability to upload the file that would really help others.
    Take care
    Smallman

  50. Smallman,
    I am new to coding. I have a sheet that has 5 different sequential merged cell groups (D10:D13, G10:G13, M7:M10, O7:O10, Q7:Q10) then I also have 5 non-sequential merged cells (B46, B48, B50, B52, B54). If I run your code from March 23 I can get the non-sequential cells and one group of the sequential cells to autofit but not the others. I then tried using your code from December 4 but have had no luck getting it to work. I am guessing I am doing something wrong but I am not sure what. Any thoughts or recommendations to get all these cells to autofit?
    Thanks,
    Dave

  51. Hi Dave
    Did you download the file to see if that would help? Is your data merged from D10 to D13 if so maybe this;
    ar = Array(“D10”, “G10”, “M7”, “O7”, “Q7”, “B46”, “B48”, “B50”, “B52”, “B54”)
    With the ar line being the one to change. If your range is merged D10 to E10, D11 to E11 etc. Then perhaps something like this will work for you.
    ar = Array(“D10”, “D11”, “D12”, “D13”, “G10”, “G11”, “G12”, “G13″,”M7”, “M8”, “M9”, “M10″,”O7”, “O8”, “O9”, “O10″,”Q7”, “Q8”, “Q9”, “Q10″,”B46”, “B48”, “B50”, “B52”, “B54”)
    It is a bit long winded but should work. I have tested both methods on my computer and both go well. Alternatively you could run two procedures. One after the other. One for the sequential cells and one for the non sequential cells. That should work too. If you have any troubles just post back on the forum and I will supply an additional file.
    Take care
    Smallman

    1. Smallman,
      Thanks for the help and the quick response! I have downloaded the file and the “OnChange” helped me setup procedures to get a single group to work. Unfortunately, when I have tried to get 2 or more groups to work I have had no luck getting this issue resolved.
      To clarify couple things from my previous post, my merged cells are D10 to F10, D11 to I11, etc. I am also wanting this procedure to run automatically.
      Below are the two procedures I have tried that have given me the closest results.
      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
      ‘Cell Ranges below, change to suit.
      ar = Array(“B46”, “B48”, “B50”, “B52”, “B54”, “D10”, “D11”, “D12”, “D13”, “G10”, “G11”, “G12”, “G13”, “M7”, “M8”, “M9”, “M10”, “O7”, “O8”, “O9”, “O10”, “Q7”, “Q8”, “Q9”, “Q10”)
      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, Range(“B46, B48, B50, B52, B54, D10, D11, D12, D13, G10, G11, G12, G13, M7, M8, M9, M10, O7, O8, O9, O10, Q7, Q8, Q9, Q10”)) Is Nothing Then
      FixMerged
      End If
      End Sub
      With this procedure all of the “B”‘s and “Q”‘s will autofit as well as G11,G12 and G13. However none of the others will.
      The other procedure(s) I have had some luck with is to separate out each group into its own procedures (b’s, d’s, m’s, etc. If I run these manually they work just fine but when I add code to automate it then I have the same issue as above. Here is the code for automating the procedures that I am trying to use.
      Private Sub Worksheet_Change(ByVal Target As Range)
      If Not Intersect(Target, Range(“D10, D11, D12, D13, G10, G11, G12, G13, M7, M8, M9, M10, O7, O8, O9, O10, Q7, Q8, Q9, Q10, B46, B48, B50, B52, B54”)) Is Nothing Then
      Call FixMergedD
      Call FixMergedG
      Call FixMergedM
      Call FixMergedO
      Call FixMergedQ
      End If
      End Sub
      Again thanks for the help,
      Dave

  52. Hi Dave
    Do you have a file? A dummy file if the data is sensitive. My email address is;
    Marcusinlondon1ATTLESyahoo.com
    Obvo Attles is the @ symbol.
    Take it easy
    Smallman

  53. Hi,
    I discovered just few steps can solve the problem.
    Step 1: set the HorizontalAlignment = xlCenterAcrossSelection, WrapText = True, MergeCells = False
    After Step1, Excel autoFit row height.
    Step 2: set MergeCells = True
    Step 3: set the HorizontalAlignment = xlLeft
    Sub Macro3()
    Range(“A1:C1”).Select
    With Selection
    .HorizontalAlignment = xlCenterAcrossSelection
    .WrapText = True
    .MergeCells = False
    End With
    Selection.Merge
    With Selection
    .HorizontalAlignment = xlLeft
    .WrapText = True
    .MergeCells = True
    End With
    End Sub
    Hope it is helpful
    Excel Programmer

  54. Great post, and once I saw what the code was doing it got me to thinking…. I was able to reproduce the same effect with a little less code.
    In my case, I could limit the print area to the first 8 columns, otherwise this solution may be useful to you. I have several rows where columns D & E are merged. For example range D25:E25 are merged and D26:E26 are merged. My solution was to add a formula out in column BA: BA26=D26 and I set the width / font of column BA = width of columns D+E. Also need to make sure column BA is set to wrap. Entering text into cell D26 will not auto fit the row height, but double clicking on the row separator does auto fit it.
    I then added code in the same Worksheet_Change method:

    If Target.column = Range("sqDescription").column then
    Target.EntireRow.AutoFit
    End If

    For this to work, I had named the table heading “sqDescription” so I knew if I was in the right column or not. You may need to add additional checks to make sure you are in the correct rows. In my case I didn’t need to do this. If you add the code, it has the same effect of clearing out the Undo list. But if you don’t mind the manual auto fit clicking of rows, you can skip the code entirely.

  55. I finally got the height to expand on my merged cells. But if the user changes the next for the next time and it is smaller then the row should go back down to a single row. I can’t seem to get that part to work. Any thoughts on what I might be doing wrong?
    Thanks

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

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

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

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

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

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

  61. Hello,
    I am using the following code and would like to know how to extend it, so it will run on 2 named ranges at the same time (str = “OneNote1” and str = “OneNote2”) As of now I can only run it on one range at a time, shown below using OneNote2. How can I add in OneNote1?
    Thanks!
    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
    Dim str02 As String
    str01 = “OneNote”
    str02 = “OneNote2”
    If Not Intersect(Target, Range(str02)) Is Nothing Then
    Application.ScreenUpdating = False
    On Error Resume Next
    Set AutoFitRng = Range(Range(str02).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

  62. Hi Linda
    Sorry for the late reply I have been away. Would it be a fair assumption that your merged cells are one cell each?
    Why don’t you just use something like this.

    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Range("OneNote", "OneNote2")) Is Nothing Then
            FixMergedA
        End If
    End Sub
    Then you can use something like this.
    Sub FixMergedA()
     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 = [{"OneNote", "OneNote2"}] 'Cell Ranges below, change to suit.
        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

    If this does not work my contact details are on my site and happy to look at your file.
    Take care
    Smallman

  63. I use Excel all day long, and ‘merge cell’ is one of the most useful features. I am not going to stop using it, but I’m also not going to add code to every worksheet I use. In my opinion, the inability of Excel to automatically adjust row height for autowrapped and merged cells is, plain and simple, a bug that Microsoft should just fix.

  64. Ted,
    I wholeheartedly agree. With all that Excel does, this is not a capacity issue but an oversight that needs fixing.

  65. Great code. I thought it was going to fix all my problems. However, when I run the code it locked the cells so that I can’t go back and make changes to the text. My workbook with be locked so employees will not be able to go back in and make the changes that they need to. How do I get around this?

  66. Hi Kate
    Sorry to hear you are having issues. Will need to see the code you are running in order to make some suggestions, as the coding above does not lock cells per se. If you like you can get my email address from my website. Happy to look at your file for you and see if I can fix any issues you are having.
    Take care
    Smallman

  67. Hi Smallman (and Debra who started the post),
    Many thanks for all your help, without which I would be pulling what’s left of my hair out.
    All the best,
    Simon

  68. i did create this little macro

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.WrapText = True Then
        With Target
            .Select
            .RowHeight = 1
            .WrapText = True
            .UnMerge
            .EntireRow.AutoFit
            Selection.Merge
            'vNewHeight = (.Width * .Height) / Selection.Width
            vNewHeight = .Width * .Height / Selection.Width
            If vNewHeight < 16 Then vNewHeight = 16
            .RowHeight = vNewHeight
            .VerticalAlignment = xlCenter
        End With
    End If
    End Sub
  69. Yes!!!!!
    I love it. Well done Juan!
    This is a very minor point, the code would not run correctly on my machine as I use Option Explicit, I added the variable declaration:

    Dim vNewHeight As Single

    then it runs like a dream. This is an evolution in this technique. Once again Well done!!!!!!
    I have to add this to my site but will credit your work. I am not easily this impressed – simply wonderful.
    Take care
    Smallman

    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
  70. Hi Smallman,
    I am very new to codes but have read the posts & trying my luck to combine the following codes from your post (on automating the autofit of rows height for merged cells, maintaining the unlocked ‘status’ of merged cells etc) & Suzi’s (on protected worksheet). However the codes don’t seem to work for my worksheet. Would really appreciate if you can help.

    Option Explicit
     Option Base 1
    Private Sub Worksheet_Change(ByVal Target As Range)
     If Not Intersect(Target, Range("C37,C38,C39,C40,C41,C42,C43,C44,C45,C46,C47,C48,M37,M38,M39,M40,M41,M42,M43,M44,M45,M46,M47,M48,W37,W38,W39,W40,W41,W42,W43,W44,W45,W46,W47,W48")) 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
     ActiveSheet.Unprotect "password" ', userinterfaceonly:=True
    Application.ScreenUpdating = False
     ar = Array("C37", "C38", "C39", "C40", "C41", "C42", "C43", "C44", "C45", "C46", "C47", "C48", "M37", "M38", "M39", "M40", "M41", "M42", "M43", "M44", "M45", "M46", "M47", "M48", "W37", "W38", "W39", "W40", "W41", "W42", "W43", "W44", "W45", "W46", "W47", "W48")
     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
     Range("C37:AF48").Locked = False
     ActiveSheet.Protect "password"
     End Sub
  71. Hi Olivia
    This method is good if you have say one column of cells where you want fitted. However, when you have the same row in two or more columns then the last columns being evaluated will affect the earlier columns as Excel will evaluate Column C, then M the way your coding is written.
    Also you don’t need to put every cell you want evaluated down in the coding. You can just put your ranges like so:
    Range(“C37:C48, M37:M48”) etc etc or [C37:C48, M37:M48] etc
    The following is an example using your first two ranges.

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim vNewHeight As Single
    ActiveSheet.Unprotect "password"
    If Not Intersect(Target, [C37:C48, M37:M48]) Is Nothing Then
        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 "password"
    End If
    End Sub
    

    Just so we are clear – if Column M is a larger bit of text say in Row 37 then this will have an adverse affect on C37. This method is best for rows which don’t have another cell being evaluated in the same column.
    Hope that helps Olivia. You can email me directly if you want me to take a look at your file but pretty sure this is the issue. Just test on one column, then 2 then 3 and you will get the idea. OR I could send you a file with the above code working beautifully.
    Take care
    Smallman

  72. Hi Smallman,
    Thank you for your reply! My merged cells is made up of a few columns in each row (total 12 rows, from Row 37 to 48), eg C37:L37, M37:V37, W37:AF37.
    Have tried your codes and encountered the following message:
    Compile error: Syntax error
    After I clicked ‘Ok’,
    ‘Private Sub Worksheet_Change(ByVal Target As Range)’ is highlighted in yellow &
    ‘If vNewHeight < 16 Then vNewHeight = 16’ is in red font.
    Not sure what these mean. Will you be able to help?
    Thanks so much!! It’s really great to have you guys around!! =)
    Olivia

  73. Hi Olivia
    There is no email address as I requested. I can send you the coding from my reply with the code running smoothly. There is a problem at your end. It will be something simple like you are putting the coding in the incorrect place.
    If you simply dump the code in a fresh file, make sure you put it in worksheet 1 module (if you want it to run on sheet1) it should be OK. That is all I will do and it will run like a dream.
    Take care
    Smallman

  74. Hello! I was able to get the row height to adjust when entering text for one cell in the sheet code (str01 = “E40” or “E42” or “E44”), but when I enter a named range (from Name Manager) in the formula (str01 = “OrderNote”) (OrderNote = E40 E42 E44) none of the cells in the named range will adjust row height. Any ideas?
    Thanks!

  75. Hi Jordan
    Have a look at the post by suzi above. There is use of this method with named ranges. If you can not make anything from the thread then email me your file. I will have a look at it later in the week when I get back from my travels.
    Take care
    Smallman

  76. Hello Smallman
    I am able to get merged cells row height autofit when merged have its text but if merged cells contain link from another sheet none of the cells autofit automatically. I have merged cells in bill sheet row 10 & coulumn C10, D10 are merged cells that have cell link from “bill data” B5. I required to automatically autofit the row height as i update the sheet “bill data”. I am new to excel and dont know vba codes very much. Plzzzzzzzz help?????

  77. Hi Debra/Smallman
    I just wanted to say thank you for all the work you’ve put into this! I know I’m posting quite late (I can see this was opened in 2012, talk about late to the party) but it has helped me so much on my latest project!
    The main issue I have had with this project is that the merged cells do not follow any sort of pattern. They are user generated from a web form – eg. When a user inputs new information under a sub-heading the extract updates with more merged cells. These cells will vary from sheet to sheet so I needed it to be dynamic as possible. That being said, if anyone else is having the same issue I have posted a very slightly tweaked code below.
    The only issue I have left now is that I seem to be getting a white gap inside the re-merged cell using the code below, but when I used Debra’s & Smallman’s code I wasn’t. Are either of you able to help at all? If you can that would be amazing! If not, I’d just like to say thanks again for all the work you’ve put into this!

    Sub FindAllMerged()
    Dim c As Range
    Dim sMsg As String
    Dim mw As Single
    Dim cw As Double
    Dim rwht As Double
    Dim rng As Range
    For Each c In ActiveSheet.UsedRange
        If c.MergeCells Then
     c.Select
    With c
          .MergeCells = False
          cw = .Cells(1).ColumnWidth
          mw = 0
          For Each cM In c
              cM.WrapText = True
              mw = cM.ColumnWidth + mw
          Next
          mw = mw + c.Cells.Count * 0.66
          .Cells(1).ColumnWidth = mw
          .EntireRow.AutoFit
          rwht = .RowHeight
          .Cells(1).ColumnWidth = cw
            With Selection
            .MergeCells = True
            End With
          .RowHeight = rwht
        End With
        End If
    Next
    End Sub
    
  78. 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

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

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

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

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

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

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

    Take care
    Smallman

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

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

  83. Hi Smallman
    Your solution for multiple merged cells in same line is perfect for my problem. However I am unable to figure out how to set the macro up for more than one block in a worksheet e.g. I want to fix merged cells in each row in block C10:O16, then A22:K30. My blocks are all fixed.
    I would very much appreciate your help.

  84. I’ve tried this code and have a problem expanding the merged cells. So as long as I stay within the allotted space it resizes, but when I type and the merged cell needs more space to fit all of the text, the code runs and Hides the rows! Please help!

  85. Thanks Debra, Smallman and all the others that have contributed to this blog with solutions to this issue.
    One thing I haven’t seen mentioned is what happens if one or more of the columns within the merged cells are (or get) hidden?
    Would there need to be some code added before/after “mw = cM.ColumnWidth + mw” to prevent adding the column width(s) of the hidden columns?

    1. Hi Gary,
      Did you get an answer to this? I am struggling with apply this macro to multiple columns that exceed the height limit.

  86. Hi
    This forum is awesome thank you Debra and Smallman. It has given me a huge amount of information to improve the quality of forms I produce. However one thing I am struggling with is sheet and password protection.
    Basically i want the whole sheet protecting apart from these cells: F9, F10, F11, F12, F13, F15, F17, F19, F21, F23, F26, F30, F33, F35, F36, F38, F40, F42, F45, F47, F51, F56, F63, F66, F68, F72. these cells either auto hide or auto expand with the below code.
    this is my current code, i have tried various forms of vba protection and each time it breaks. any help with this would be greatly appreciated. I have ensure the above list of cells have been unlocked by right clicking, selecting protection and untick locked.
    Thank you in advance
    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
    If Range(“F48”) = “Please Select” Then
    Rows(“50:55”).EntireRow.Hidden = True
    End If
    If Range(“F48”) = “No” Then
    Rows(“50:55”).EntireRow.Hidden = True
    End If
    If Range(“F48”) = “Yes” Then
    Rows(“50:51”).EntireRow.Hidden = False
    Rows(“52:53”).EntireRow.Hidden = True
    Rows(“54:55”).EntireRow.Hidden = False
    End If
    If Range(“F50”) = “Yes” Then
    Rows(“52:53”).EntireRow.Hidden = False
    End If
    If Range(“F50”) = “No” Then
    Rows(“52:53”).EntireRow.Hidden = True
    End If
    If Range(“F57”) = “Please Select” Then
    Rows(“59:65”).EntireRow.Hidden = True
    End If
    If Range(“F57”) = “Yes” Then
    Rows(“59:65”).EntireRow.Hidden = True
    End If
    If Range(“F57”) = “No” Then
    Rows(“59:63”).EntireRow.Hidden = False
    Rows(“64:65”).EntireRow.Hidden = True
    End If
    If Range(“F62”) = “Please Select” Then
    Rows(“64:65”).EntireRow.Hidden = True
    End If
    If Range(“F62”) = “Yes” Then
    Rows(“64:65”).EntireRow.Hidden = False
    End If
    If Range(“F62”) = “No” Then
    Rows(“64:65”).EntireRow.Hidden = True
    End If
    If Range(“F67”) = “Please Select” Then
    Rows(“69:71”).EntireRow.Hidden = True
    End If
    If Range(“F67”) = “No” Then
    Rows(“69:71”).EntireRow.Hidden = True
    End If
    If Range(“F67”) = “Yes” Then
    Rows(“69:71”).EntireRow.Hidden = False
    End If
    If Not Intersect(Target, Range(“F17,F21,F23,F26,F30,F52,F64,F69,F73”)) 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
    ‘Cell Ranges below, change to suit.
    ar = Array(“F17”, “F21”, “F23”, “F26”, “F30”, “F52”, “F64”, “F69”, “F73”)
    For i = 0 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

  87. Thanks for the code I have a question though:
    My row of data is greater than the 409 limit that Excel allows, that’s why I’m merging cells. The issue I’m having is the max this will create a cell is 409 divided by the total number of rows and it can never be more. My test data needs to be 1200 total so 400 each row (3 rows merged) but instead it is 136 each. Can you think of any work arounds?
    I hope this makes sense. Please let me know if not!
    Thanks!

  88. Hi everyone,
    I’m experiencing the same issue that Suzi had. The first code displayed works, but it locks the cell. I tried using the suggested codes in the responses to Suzi but I cannot get anything to work. Say the only cell that I want to autofit text is A55. It’s merged from A55-K55. What would I add to the initial code (pasted below) to unlock that cell? Thank you in advance!
    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 = “A55”
    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

  89. Hi,
    Like most posts here I am in the same position in firstly trying to lean the coding structure for a similar problem I would like to solve!

    Having seen multiple posts here to solve a problem I believe that the one I have can be solved but at this stage in my understanding I am unable to solve it, hence the cry for help!

    I have the folowing problem;
    5 rows of information covered by two columns, each column has merged cells lets say for example
    – each row contains 24 columns , 17 columns (merged) x 7 columns (merged) no spaces between the two column areas
    – text entered in to each of the merged columns can be different length (data in the 7 column area maybe entered with small text entries seperated by ALT return in the cell, i.e. kind of a list)
    – I would like to modify the code to check which of the two areas height is greatest and then resize the row based on this once change is made in any of the cloumn areas.

    It would appear that I need a mixture of Smallman post (September 28, 2014 at 10:59 PM ) and juan sanchez post (February 26, 2015 at 12:51 PM)

    Any suggestions on how this could be achieved? If further explaination is needed please let me know?

  90. Thanks for this, very useful.

    Just another minor point that maybe someone else has already noted.

    I’ve adapted MergedAreaRowAutofit from https://www.thesmallman.com/autofit-merged-cells

    The code assumes constant font, font size and font bold status. But if these differ they can all impact the height if they are not the same between the merge cell and the cell used to calc height.

    To get around this… I’ve simply added:
    Dim f As String, fs As Double, fb As Boolean

    Then in the code:
    Set rngMArea = .Cells(j, n).MergeArea
    f = .Font.Name
    fs = .Font.Size
    fb = .Font.Bold
    With rngMArea

    And then…
    With .Parent.Cells(.Row, SpareCol)
    .Value = rngMArea.Value
    .Font.Name = f
    .Font.Size = fs
    .Font.Bold = fb
    .ColumnWidth = MW

    Hoping this helps someone who may find the heights don’t always work 🙂

    I also turned it into a function that gets called by a more complex reporting tool… saved me hours!
    Thanks Again
    Tim

  91. Hi,

    This is some good code and seems to work in most cases. However, it doesn’t seem to work for me when the text is changed through a worksheet macro. The function executes, but the calculated row height does not take into account the copied text.

    Any thoughts?

  92. All,
    I wanted to post a solution that I came up with based on the work posted by Debra, Smallman and Juan Sanchez. While using Juan Sanchez’s macro, I noticed that after a certain string length in a given cell the macro “broke” and wouldn’t function as intended. Because of this, I went back to Smallman’s site and worked through some of the code there to come up with a work-around that would allow me to have longer string values in the merged cells and incorporate some of the formatting that I’ve got in my particular spreadsheet.
    I’ve pasted the comment-documented code snippet below. To give a little background on the way the spreadsheet is set up, on the sheet that this macro runs in all of the longer merged cells start in column “B” and have a fixed length (I am ensured this by sheet protection and separate macro-driven block inserts). As a result of this, I have the fixed values for the unmerged column width and the merged block width incorporated as static variables. I left out the sheet unprotect/protect routine, because that is documented elsewhere in this comment thread and that code section should transfer without issue.
    Option Explicit

    Private Sub Worksheet_Change(ByVal Target As Range) ‘ “Target” is the changed cell range
    Dim TotalWidth As Single ‘ target cell range overall width
    Dim ColWidth As Single ‘ target cell range first column width
    TotalWidth = 117.43 ‘ Original width of cell range is 117.43
    ColWidth = 4.71 ‘ Original width of column “B” is 4.71
    ‘ ———-
    If Target.WrapText = True Then
    Application.ScreenUpdating = False ‘ turn off screen updates during process
    With Target
    .Select ‘ selects the target cell range
    ActiveSheet.Columns(“B”).ColumnWidth = TotalWidth ‘ sets the first column width to that of the original range
    .RowHeight = 20 ‘ sets row height to default value
    .WrapText = True ‘ ensures cell WrapText property is set to TRUE
    .UnMerge ‘ unmerges the cells in target selection
    .EntireRow.AutoFit ‘ auto-fits the row height
    Selection.Merge ‘ merges the target cell range
    ActiveSheet.Columns(“B”).ColumnWidth = ColWidth ‘ restores the column width to its original value
    .VerticalAlignment = xlCenter ‘ sets vertical text alignment of target cell range to centered
    End With
    Application.ScreenUpdating = True ‘ turns on screen updating
    End If
    End Sub

    Regards,
    Matthew Sosa

  93. Good morning; I have been able to get your script running on my document, however, since my doc is password protected for other users it wont run the macro. Here is the script I managed to get working:

    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range(“B1,B17,B32,B34,B36”)) 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(“B1”, “B17”, “B32”, “B34”, “B36″)
    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

    This script works as I want it: information is entered into the merged cell, and the formatting of the merged cell happens automatically without the user having to force the macro to run. Great! However, I have to have the form password protected. What can I add/change to the above script to account for a password protected document that does not allow changes to formatting? Help is much appreciated!!

  94. I’m working on BOQ sheet item column unfortunately the above code is not work. Pls help me out if possible. I want to entire column set as autofit merged cell.

  95. This is a great post! I have learned a lot. My workbook includes multiple sheets, I’d like to use this “AutoFit Merged Cell Row Height” code in all my active sheets. So, I added a loop before the code of “AutoFit Merged Cell Row Height”, but it doesn’t work. Can anyone could help improve my code below to make it work. I appreciate your time.

    Option Explicit
    Option Base 1
    Sub FixMerged()

    Dim mySheet As Object
    For Each mySheet In Sheets
    With mySheet
    If .Visible = True Then .Select Replace:=False
    End With
    Next mySheet

    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(“A7”, “B8”, “B11”, “B32”, “B33”)
    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

  96. Hi all,

    Does anyone can help update the Autofit Merged Cells Code to make it works for all active sheets in a workbook?

    I added the following code before the Autofit Merged Cells Code, but it doesn’t work. It still only works for the first/current sheet.

    Dim mySheet As Object

    For Each mySheet In Sheets

    With mySheet

    If .Visible = True Then .Select Replace:=False

    End With

    Next mySheet

    Any suggestion or inputs will be appreciated.

Leave a Reply

Your email address will not be published.

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