Autofit the row height when there are merged cells

Hi Norman, first of all, thank you your help.  I tried that switch and found that it worked perfectly if 1 row of content was entered, but then Excel went back to 17 per row:

1 row = 20 pixels

2 rows = 34

3 rows = 51

4 rows = 68

Do you have any idea how this might be altered so that each row is 20 regardless of how many rows of content there are?

Thanks again!

Hi Ken,

Try replacing the code in your worksheet module with the following version:

'===========>>

Option Explicit

'----------->>

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Rng As Range

    Const str01 As String = "OrderNote"

    Set Rng = Intersect(Target, Range(str01))

    If Not Rng Is Nothing Then

        Call SetRowHeights(Me, Rng)

    End If

End Sub

'<<===========

Then, in a general module. paste the following light adaptation of Bill Manville's code, referred to in the alternative approaches link in my previous response - adaptation's are shown in bold type: 

'===========>>

Option Explicit

'----------->>

Sub SetRowHeights(Sh As Object, Optional aRng As Range)

    ' sets row heights in sheet Sh.

    ' Excel doesn't correctly set row height when merged cells have wrapped text

    Dim C As Range, rRow As Range, myRng As Range

    Dim sHeight As Single

    Dim sBestHeight As Single

    Dim bUpdate As Boolean

    Dim bHid As Boolean

    Dim iHidCol As Integer

    Dim cSizer As Range

    ' switch off screen updating to speed up the process

    bUpdate = Application.ScreenUpdating

    Application.ScreenUpdating = False

  If aRng Is Nothing Then

Set myRng = Sh.UsedRange

Else

Set myRng = aRng

End If

    ' this process is only relevant to worksheets, not chart sheets

    If TypeName(Sh) = "Worksheet" Then

        If IsNull(myRng.WrapText) Or myRng.WrapText Then

            ' text wrapping done in some cells in the sheet / myRng

            Workbooks.Add xlWorksheet    ' temporary workbook

            Set cSizer = Range("A1")  ' a cell to use as workspace

            For Each rRow In myRng.Rows

                If IsNull(rRow.WrapText) Or rRow.WrapText Then

                    ' there are cells on this row with wrapped text

                    If IsNull(rRow.MergeCells) Then

                        ' no merged cells so can use Excel's autofit

                        rRow.EntireRow.AutoFit

                    Else

                        ' row has merged cells and wrapped text

                        sBestHeight = 15

                        For Each C In rRow.Cells

                            ' copy the content of the cell to a spare cell in Terms and Autofit there

                            If C.Address = C.MergeArea.Range("A1").Address _

                               And C.WrapText And Not C.EntireColumn.Hidden Then

                                ' first of a merged cell, or a single cell, with wrapped text

                                ' and column not hidden

                                ' set the single cell in Terms to match the (merged) cell here

                                cSizer.Value = C.Text

                                cSizer.Font.Size = C.Font.Size

                                cSizer.Font.Bold = C.Font.Bold

                                ' Width is measured in Twips and we can find the width of the MergeArea

                                ' but we can only set the ColumnWidth which is measured in different units

                                ' so scale the Width appropriately

                                cSizer.EntireColumn.ColumnWidth = _

                                        C.MergeArea.Width * cSizer.ColumnWidth / cSizer.Width

                                cSizer.WrapText = True

                                ' use AutoFit to find the right row height for this cell

                                cSizer.EntireRow.AutoFit

                                ' get the height

                                sHeight = cSizer.RowHeight

                                ' if the cell is merged vertically then we need less height than this

                                If C.MergeArea.Rows.Count > 1 Then

                                    ' adjust height down for later rows

                                    sHeight = sHeight - (C.MergeArea.Rows.Count - 1) * (C.Font.Size + 2.75)

                                End If

                            Else

                                sHeight = C.Font.Size + 2.75

                            End If

                            ' take the greatest height for this row so far

                            If sHeight > sBestHeight Then sBestHeight = sHeight

                        Next

                        ' if the row isn't the correct height

                        If rRow.EntireRow.RowHeight <> sBestHeight Then

                            ' set it to the correct height

                            rRow.EntireRow.RowHeight = sBestHeight

                        End If

                    End If

                End If

            Next

            ' close the helper workbook

            ActiveWorkbook.Close False

        End If

    End If

    ' restore screenupdating to its previous state

    Application.ScreenUpdating = bUpdate

End Sub

'<<===========

===

Regards,

Norman

Hi Norman, I apologize as I'm very new to VBA, but I think I did all of the above correctly and got the same result:  1 row = 20, 2 = 34, 3 = 51, 4 = 68, etc.

To add the worksheet module, I brought up "view code" on the worksheet, which is called "LOSS EVALUATION" and pasted what you drafted, which caused it to turn to "worksheet" and "change".

To add the general module, I clicked insert-module, which created module 4 (the previous caretaker of this worksheet created the other 3).  I then pasted what you drafted, which caused it to turn to "General" and "SetRowHeights".  I also noticed that, when I go back to Sheet 2 (LOSS EVALUATION) in the project explorer, I can now see what I presume to be this code (it reads "Option Explicit") above what was entered previously.

Thanks again and sorry this is such a pain!

Hi Ken,

There is absolutely no need to be apologetic, Indeed, there is every chance that I may not properly have understood your scenario.

However, your original code was event code which was designed to act in response to a change in the range OrderNote. The code suggested by me also utilises the Worksheet_Change event, but relies on a modification of Bill Manville's code to do the row height manipulation for the merged cells.

In both cases, the code will operate in response to a recognised change; it will not act retrospectively,

Therefore, as a one-off operation to deal with historic data, paste the following procedure into your new Module4 and then run the procedure:

'===========>>

Public Sub Tester()

    Dim SH As Worksheet

    Dim Rng As Range

    Dim aRow As Range

    Set SH = ThisWorkbook.Sheets("LOSS EVALUATION")

    Set Rng = SH.Range("OrderNote")

    For Each aRow In Rng.Rows

        Call SetRowHeights(SH, aRow)

    Next aRow

End Sub

'<<===========

You can run this code directly from the code module by placing the cursor in the procedure and pressing F5, or from the worksheet by opening the macro window with F8 and selecting Tester.

Run this code on a copy of your workbook!

Subsequent changes in the data of interest should be handled by your Worksheet_Change code.

===

Regards,

Norman

Hi Norman, I apologize as I'm very new to VBA, but I think I did all of the above correctly and got the same result:  1 row = 20, 2 = 34, 3 = 51, 4 = 68, etc.

To add the worksheet module, I brought up "view code" on the worksheet, which is called "LOSS EVALUATION" and pasted what you drafted, which caused it to turn to "worksheet" and "change".

To add the general module, I clicked insert-module, which created module 4 (the previous caretaker of this worksheet created the other 3).  I then pasted what you drafted, which caused it to turn to "General" and "SetRowHeights".  I also noticed that, when I go back to Sheet 2 (LOSS EVALUATION) in the project explorer, I can now see what I presume to be this code (it reads "Option Explicit") above what was entered previously.

Thanks again and sorry this is such a pain!

Hi Norman, first of all, thank you your help.  I tried that switch and found that it worked perfectly if 1 row of content was entered, but then Excel went back to 17 per row:

1 row = 20 pixels

2 rows = 34

3 rows = 51

4 rows = 68

Do you have any idea how this might be altered so that each row is 20 regardless of how many rows of content there are?

Thanks again!

Hi Ken,

Try changing the code line

       NewRowHt = .RowHeight

to

        NewRowHt = Application.Max(.RowHeight, 15)

NB: the RowHeight property sets or returns a height measured in points.

20 pixels = 15 points

Edit: See http://http://office.microsoft.com/en-us/excel-help/measurement-units-and-rulers-in-excel-HP001151724.aspx

For alternative approaches to your code, see:

http://answers.microsoft.com/en-us/office/forum/office_2007-excel/merged-cells-row-height/c6ce62af-86ac-4b03-a644-92a0ab744f96

===

Regards,

Norman