Modifying code that autofits the row height of merged cells

Michael David

New member
Joined
Mar 5, 2014
Messages
2
Reaction score
0
Points
0
Hi I'm using the code below on a couple different worksheets and have found that, on one sheet where the merged columns total 1,146 pixels, Excel limits the # of rows to 6, i.e. if you enter more content than would be visible in 6 rows, it's not displayed. On another sheet where the merged columns total 815 pixels, a limit still exists, but now it's 8 rows.

Does anybody know any way around this? The fields that I am using this for on the sheet with 1,146 pixels really needs to display at least 10 rows if the user enters that much content.

Thanks!


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim MergeWidth As Single
Dim cM As Range
Dim AutoFitRng As Range
Dim CWidth As Double
Dim NewRowHt As Double
Dim str01 As String
str01 = "LossEval"
If Not Intersect(Target, Range(str01)) Is Nothing Then
Application.ScreenUpdating = False
Me.Unprotect
On Error Resume Next
Set AutoFitRng = Range(Range(str01).MergeArea.Address)
With AutoFitRng
.MergeCells = False
CWidth = .Cells(1).ColumnWidth
MergeWidth = 0
For Each cM In AutoFitRng
cM.WrapText = True
MergeWidth = cM.ColumnWidth + MergeWidth
Next
'small adjustment to temporary width
MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
.Cells(1).ColumnWidth = MergeWidth
.EntireRow.AutoFit
NewRowHt = Application.Max(.RowHeight, 15)
.Cells(1).ColumnWidth = CWidth
.MergeCells = True
.RowHeight = NewRowHt
End With
Me.Protect
Application.ScreenUpdating = True
End If
End Sub
 
can you attach a sample file ?
 
Hi Patel, sample file attached. This is the worksheet that allows up to 8 rows.

Thanks,

Ken
 

Attachments

  • sample.xls
    70 KB · Views: 12
Back
Top