0

I have a little problem in excel. I not experienced with excel macros and would be grateful for some help. I am trying to find a macro which ajustes the height of a merged cell to fit its content. automatically. I found something with which could do that for cells in several columns but not for several rows and also not automatically:

 Sub AutoFitMergedCellRowHeight()
 Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
 Dim CurrCell As Range
 Dim ActiveCellWidth As Single, PossNewRowHeight As Single
 Dim iX As Integer

 If ActiveCell.MergeCells Then
    With ActiveCell.MergeArea
         If .Rows.Count = 1 And .WrapText = True Then
             Application.ScreenUpdating = False
             CurrentRowHeight = .RowHeight
             ActiveCellWidth = ActiveCell.ColumnWidth
             For Each CurrCell In Selection
                 MergedCellRgWidth = CurrCell.ColumnWidth + _
                    MergedCellRgWidth
                 iX = iX + 1
             Next
             MergedCellRgWidth = MergedCellRgWidth + (iX - 1) * 0.71
             .MergeCells = False
             .Cells(1).ColumnWidth = MergedCellRgWidth
             .EntireRow.AutoFit
             PossNewRowHeight = .RowHeight
             .Cells(1).ColumnWidth = ActiveCellWidth
             .MergeCells = True
             .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
              CurrentRowHeight, PossNewRowHeight)
         End If
     End With
 End If

End Sub

The end result should look like this:enter image description here Thank you in advance.

1
  • You should be able to follow a similar pattern for rows: if the cells are merged then unmerge them, autofit the first cell and note the fitted row height. Then remerge the cells and set the last cell height equal to the height you noted minus the height of all the other rows. Oct 15, 2013 at 15:48

3 Answers 3

4

Something like:

Dim h, rng As Range
Set rng = Selection

With rng
    .UnMerge
    .Cells(1).EntireRow.AutoFit
    h = .Cells(1).RowHeight
    .Merge
    .EntireRow.AutoFit
    With .Cells(1).MergeArea
        .Cells(.Cells.Count).RowHeight = _
           .Cells(.Cells.Count).RowHeight + (h - .Height)
    End With
End With
1
  • This does not work in case the height of the rng.Cells(1).MergeArea is larger than the height of the rng.Cells(1).RowHeight as it in that case tries to set negative RowHeight to last cell of the MergeArea. This can be fixed by adding an if to the last "With" section like this: With .Cells(1).MergeArea If h > .Height Then .Cells(.Cells.Count).RowHeight = _ .Cells(.Cells.Count).RowHeight + (h - .Height) End If End With
    – juhako
    Sep 24, 2014 at 6:35
4

There is a much easier way of doing this if you allow the Excel sheet to do some of the heavy lifting for you.

The following example works in the common scenario that you have some cells that comprise several columns but only a single row (i.e. some columns are merged together on a single row). The usual problem is that the row height for wrapped text in the merged cell does not accomodate the height of the wrapped text in some circumstances (e.g. the result of a formula or database lookup gives a large and varying amounts of text)

To solve this, simulate single celled versions of the merged cells by doing the following in some columns that are not visible to the user:

  1. In a single cell that is on the same row as the merged cell, place an identical formulae or simply set the formulae equal to a reference to the merged cell.
  2. Do this for all merged cells.
  3. Make the width of the single cell versions equal to the width of each merged cell(s). You now have a set of single celled versions of the merged cells, on the same rows, but with the same column width.
  4. Name these single cells.
  5. Write a function that loops through all of these named single cell ranges and calls the following function for each:

    Private Sub AutosizeLongFormInput(rng As Range)
        If Not rng.EntireRow.Hidden = True Then
            rng.EntireRow.AutoFit
        End If
    End Sub
    

2
  • Step 3 seems tricky for me, because of mismatching units of measurement. For example, .MergeArea.Width comes back as 48 for the standard column width 8.43 (64 pixels). Trying to set the width of a copy cell from this has left me taking a convoluted approach of trying once, seeing how far off I was, adjusting by the error factor and trying again! It works but it's horrid. Have I missed something?
    – AjV Jsy
    Jul 14, 2016 at 15:09
  • @AjV Jsy- The solution I posted assumes you have some constant width merged cells and simply want to auto adjust the height of the row to fit their wrapped text. So the process of setting the width of the copy cells is manual at design time. If you make the copy cells slightly narrower than the real merged cells then they should give you an auto height that's always large enough to fit all of the text. if you need to do this a lot then write a quick utility macro that gives the sum of the width of the cells selected, in order to help getting the width required for the copy cells.
    – steve_cdi
    Jul 29, 2016 at 17:31
0

What about this:

'rRang is range of cells which are merged together

Sub AutoFitRowMergedCells(rRang As Range)

Dim iColW As Integer, iColWold As Integer, I As Integer

iColW = 0

For I = 1 To rRang.Columns.Count
    iColW = iColW + rRang.Range("A" & I).ColumnWidth
Next I

rRang.UnMerge
iColWold = rRang.Range("A1").ColumnWidth
rRang.Range("A1").ColumnWidth = iColW
rRang.Range("A1").EntireRow.AutoFit
rRang.Range("A1").ColumnWidth = iColWold
rRang.Merge

End Sub

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.