asked on

Excel AutoHeight on Merged Cells

I have rows where columns F and G are merged. I need to display a large amount of text, that could vary per row.

After I dump data to the workbook, I want to run a macro that will go through all the rows in the sheet "WorkOrder" for columns F&G (merged) and adjust the height of the row to account for the amount of text.

I have tried the following, but it is not working:

Sub macAutoFitMergedCellRowHeight()
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range, RangeWidth As Single

    Dim ActiveCellWidth As Single, PossNewRowHeight As Single
    If ActiveCell.MergeCells Then
       With ActiveCell.MergeArea
            If .Rows.Count = 1 And .WrapText = True Then
                Application.ScreenUpdating = False
                CurrentRowHeight = .RowHeight
                ActiveCellWidth = ActiveCell.ColumnWidth
                RangeWidth = .Width

                For Each CurrCell In Selection
                    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
                Next
                .MergeCells = False
                .Cells(1).ColumnWidth = MergedCellRgWidth
                While .Cells(1).Width < RangeWidth
                  .Cells(1).ColumnWidth = .Cells(1).ColumnWidth + 0.5
                Wend
                .Cells(1).ColumnWidth = .Cells(1).ColumnWidth - 0.5

                .EntireRow.AutoFit
                PossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = ActiveCellWidth
                .MergeCells = True
                .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
                 CurrentRowHeight, PossNewRowHeight)
            End If
        End With
    End If
End Sub

Open in new window

Rgonzo1971

Hi,

to work the merged cells must have Wrap text ticked

Sub macAutoFitMergedCellRowHeight()
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range, RangeWidth As Single

    Dim ActiveCellWidth As Single, PossNewRowHeight As Single
    For Each c In Range(Range("F1"), Range("F" & Rows.Count).End(xlUp))
    c.Activate
    If ActiveCell.MergeCells Then
       With ActiveCell.MergeArea
            If .Rows.Count = 1 And .WrapText = True Then
                Application.ScreenUpdating = False
                CurrentRowHeight = .RowHeight
                ActiveCellWidth = ActiveCell.ColumnWidth
                RangeWidth = .Width

                For Each CurrCell In Selection
                    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
                Next
                .MergeCells = False
                .Cells(1).ColumnWidth = MergedCellRgWidth
                While .Cells(1).Width < RangeWidth
                  .Cells(1).ColumnWidth = .Cells(1).ColumnWidth + 0.5
                Wend
                .Cells(1).ColumnWidth = .Cells(1).ColumnWidth - 0.5

                .EntireRow.AutoFit
                PossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = ActiveCellWidth
                .MergeCells = True
                .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
                 CurrentRowHeight, PossNewRowHeight)
            End If
        End With
    End If
    Next
End Sub

Open in new window

Regards

maverick0728

ASKER

Thanks.
I'm getting an error:
Run-time error '1004':
Unable to set the ColumnWidth property of the Range class

going into debug mode shows this line having a value of 264.04:
.Cells(1).ColumnWidth = MergedCellRgWidth

Rgonzo1971

Could you send a dummy example?

maverick0728

ASKER

Rgonzo1971 - see attached.
example.xls

ASKER CERTIFIED SOLUTION

Rgonzo1971

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

maverick0728

ASKER

Thanks for your awesome help!