problem with height of merged cells

[Adev111]

Hi,

I am having problems with row heights of merged cells. It works almost
perfect. The problem comes in when the text in the cell is two or three
lines. For instance if the merged cell initial width is 50 and initial
height is 13.5, n the text is about such that it fits in two lines i.e.

"asdfdsafasdfkjasdfjadsfsadfadsfdsafadsfdsafasdfsadf..." initially all
text not visible

After I run this function I see the text like this
"asdfdsafasdfkjasdfjadsfsadfadsfdsafadsfdsafasdfsadf
asfasdfasdfasdfasdfasdfasdfasdfasdfasdfadsfasd

"

This results in taking up more height for the row. As you can see, it
only needs about two rows to fit in text. Now I have sorta gotten close
to where the problem could be, it could be in the statement :
PossNewRowHeight = .RowHeight
So if I do PossNewRowHeight = .RowHeight -
curentRowHeight

The above appears expected, but it messes up the logic and the other
rows do not get merged right and seems like no formatting gets done.

Would someone please suggest where the problem could be?

Thank You

Adev111

here's the function I found from google groups

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

 

[Guest]

There's nothing wrong with the line you cite. This code:

.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)

keeps the row height at the maximum even if the text is reduced. I don't
know why it was written this way. Instead, I would go with:
..RowHeight = PossNewRowHeight


I also append code from a recent post of mine that will run automatically if
pasted to the worksheet's code module. Note that both the code you posted and
mine are derived from an old Jim Rech post. He originated this approach to my
knowlege.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range

With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
Application.ScreenUpdating = True
End If
End With
End Sub

Regards,
Greg