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.

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

Automatically Adjust Row Height

To fix the worksheet, so the merged cells adjust automatically, you can add event code to the worksheet.

The merged cells are named OrderNote, and that name will be referenced in the event code.

mergecellsautofit03

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 something that you'll use in your workbooks? Please let me know in the comments.

__________________

Related Posts Plugin for WordPress, Blogger...

Share and Enjoy

  • Facebook
  • Twitter
  • LinkedIn
  • Google Plus
  • Pinterest

70 comments to AutoFit Merged Cell Row Height

  • Jeff Weir

    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.

  • 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

  • Johan

    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

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

  • Johan

    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

  • Steve

    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?

  • Ged Warren

    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

  • Ged Warren

    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

    • Clare

      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!

  • rick

    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.

  • [...] Unfortunately Row AutoFit doesn't work with merged cells. For a VBA solution see: AutoFit Merged Cell Row Height | Contextures Blog [...]

  • Kris

    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.

  • Debi

    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.

  • Joe

    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!

  • 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

    • Suzi

      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

    • Peter Psilakis

      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

  • Jeff Weir

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

  • 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

  • Jeff Weir

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

  • 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

  • Jeff Weir

    Yes, both work. But after your code has been run once, it's superfluous.

  • Yes I did mention that or did you miss that bit? It is just above in black and white.

    Take care

    Smallman

  • Jeff Weir

    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"

  • Suzi

    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

  • Smallman

    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

    • Suzi

      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

  • Smallman

    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

  • [...] AutoFit Merged Cell Row Height | Contextures Blog [...]

  • Eric

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

  • chuck thiele

    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

  • Waveney

    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,

    • Smallman

      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

  • Meredith

    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.

  • Meredith

    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.

  • scott

    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.

  • Meredith

    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

  • Smallman

    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

  • Roberto Belloso

    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.

  • Smallman

    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

  • Roberto Belloso

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

  • Smallman

    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

  • Dan

    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

  • Smallman

    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

  • Sideshow

    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?

  • Chris

    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

  • Doctorhifi

    This code wipes out the undo stack.
    Is there a way to keep the undo stack while using this code?

  • Smallman

    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

  • Smallman

    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

  • Noel

    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

  • Smallman

    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

    • Noel

      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!

  • Smallman

    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

  • Noel

    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

  • Smallman

    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

  • Smallman

    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

    • Patrick

      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

  • Noel

    Hi Smallman,

    Thanks for posting a download link to the sample file. Unfortunately I receieve an "error on page" after the link goes to rapidshare. I share files via copy.com @ https://copy.com?r=oJPo1U

    Thanks,

    Noel

  • Christine

    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

  • Smallman

    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

  • Smallman

    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.

    [code]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[/code]

    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

  • Smallman

    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

  • Dave

    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

  • Smallman

    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

    • Dave

      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

  • Smallman

    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

  • Excel Programmer

    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

Leave a Reply

  

  

  

You can use these HTML tags

<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>