Auto-Adjust Row Height For Wrapped Cells Macro

[JADownie]

Hello -

I have created a form in Excel where users will supply updates to me and print the page for their records. I am having an issue now with wrapped text in certain cells where some has typed more than what will display in the standard cell height. I have these cells set to wrap text, and it does, but the rows are still not tall enough to show what they typed. Is there a way to automatically re-size the height of cells when text wraps like this?

I did some looking around this morning, and found a code, but I am getting an error in Excel at the line in bold below. If someone online now has a few minutes to take a look at this code, and give me any insights I would be extremely thankful! I have spent an hour now this morning trying to get something to work... Thanks!

Sub AutoFitMergedCellRowHeight()
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
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
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth +MergedCellRgWidth
Next
.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

 

[JADownie]

I just found this other code now below, which does appear to work. However, my question now is, how can I possibly trigger this macro happen automatically anytime text is wrapped, and a row height needs to be adjusted? Can that be done automatically, or would I need to physically run this macro each time I need it done?

Thanks so much for any insight you can provide here!!


Sub test()
SetRowHeights ThisWorkbook.Sheets("Sheet1")
End Sub
Sub SetRowHeights(Sh As Object)
' 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
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


' this process is only relevant to worksheets, not chart sheets
If TypeName(Sh) = "Worksheet" Then
If IsNull(Sh.UsedRange.WrapText) Or Sh.UsedRange.WrapText Then
' text wrapping done in some cells in the sheet
Workbooks.Add xlWorksheet ' temporary workbook
Set cSizer = Range("A1") ' a cell to use as workspace

For Each rRow In Sh.UsedRange.Rows
If IsNull(rRow.WrapText) Or rRow.WrapText Then
' there are cells on this row with wrapped text
If Not 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 = 12.75
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

 

[JADownie]

Has anyone else ever encountered this, and what have you done the account for a workbook with rows which require varying row heights?

 

[kpark91]

I just select the rows and doubleclick on the border of the row number headers.

 

[JADownie]

I was hoping to automate that "click" somehow so if the user types in a cell and then clicks out of the cell, that row will re-size if necessary...

 

[JADownie]

Has anyone figured anything out for something like this ever before? I have spent the past few months looking for a good solution to this, but I am still coming up with nothing... Thank you in advance for any help today!