[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Excel AutoHeight on Merged Cells

Posted on 2014-08-26
6
Medium Priority
?
511 Views
Last Modified: 2014-08-26
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

0
Comment
Question by:maverick0728
  • 3
  • 3
6 Comments
 
LVL 54

Expert Comment

by:Rgonzo1971
ID: 40285975
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
0
 

Author Comment

by:maverick0728
ID: 40286106
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
0
 
LVL 54

Expert Comment

by:Rgonzo1971
ID: 40286115
Could you send a dummy example?
0
Fill in the form and get your FREE NFR key NOW!

Veeam is happy to provide a FREE NFR server license to certified engineers, trainers, and bloggers.  It allows for the non‑production use of Veeam Agent for Microsoft Windows. This license is valid for five workstations and two servers.

 

Author Comment

by:maverick0728
ID: 40286232
Rgonzo1971 - see attached.
example.xls
0
 
LVL 54

Accepted Solution

by:
Rgonzo1971 earned 2000 total points
ID: 40286262
Corrected code

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
    Set g = ActiveCell.MergeArea
       With ActiveCell.MergeArea
       
            If .Rows.Count = 1 And .Columns.Count = 2 And .WrapText = True Then
                Application.ScreenUpdating = False
                CurrentRowHeight = .RowHeight
                ActiveCellWidth = ActiveCell.ColumnWidth
                RangeWidth = .Width
                 MergedCellRgWidth = 0
                For Each CurrCell In ActiveCell.MergeArea
                    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
                Next
                .MergeCells = False
                d = c.Address
                 a = .Address
                .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

0
 

Author Closing Comment

by:maverick0728
ID: 40286417
Thanks for your awesome help!
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
Having trouble getting your hands on Dynamics 365 Field Service or Project Service trial? Worry No More!!!
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

872 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question