Hi.

I'm trying to make a merged cell automatically resize vertically
according to the number of lines of text I put into it.

I found a piece of code that works but only when I add text. If I
cancel all the text, the cell won't automatically shrink to one line
height.
To get this behaviour, I thought to use the following code in the
"change" event section of the worksheet I'm working on:


Code:
--------------------
....
if target.value = "" then
target.rows.autofit
else
(..... code that increase the row height accordingly to the numbers of text lines)
end if
....
--------------------


but, as soon as I hit the cancel key after selecting the cell, I get a
VBA error: "not matching type" (not sure it's these words as I'm
getting it in Italian: "tipo non corrispondente").

This "target.value" works OK if I'm putting text into the cell instead
of canceling it.

Can anybody help me, please?

Also, please let me know if, when this all will be perfectly working
(one day, I hope it will), anyone would be interested in the whole
code. I'll be glad to share it and get the feedback. For me, this is a
big lacking of in Excel formatting functions. I know there is that
"Center in the colomns" but, what if I have to "Leften in the
columns"?

Thanks.


--
fabiospark
------------------------------------------------------------------------
fabiospark's Profile: http://www.excelforum.com/member.php...o&userid=29327
View this thread: http://www.excelforum.com/showthread...hreadid=490526

The below code was adapted from Jim Rech's original code on the subject. To
my knowledge he originated this approach. Assuming that columns are merged
and that cell A3 is the active cell in the merged range:

Dim OldRng As Range 'Delare this at top of module

Private Sub Worksheet_SelectionChange(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

Set c = Range("A3")
If OldRng Is Nothing Then Set OldRng = c
If Not Intersect(OldRng, c) Is Nothing Then
Application.ScreenUpdating = False
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
Application.ScreenUpdating = True
End If
Set OldRng = Target
End Sub

Regards,
Greg

Further to my post, ensure that the WrapText property is set to True for the
merged range.

An alternative is to have a single cell in the same row have a width exactly
equal to the merged range (combined widths of the merged cells) and have it
reference the active cell by formula (i.e. "=A3"). Its WrapText property must
be set to True and font size and alignment properties must be the same as the
active cell of the merged range. It can be off screen and the font colour can
be the same as the cell interior colour in order to hide it. Then use
Worksheet_Change to autofit the row height of this cell. Since it is in the
same row it will also work for the merged range. Example:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A3")) Is Nothing Then _
Range("E3").EntireRow.AutoFit
End Sub

Regards,
Greg


"Greg Wilson" wrote:

The below code was adapted from Jim Rech's original code on the subject. To
my knowledge he originated this approach. Assuming that columns are merged
and that cell A3 is the active cell in the merged range:

Dim OldRng As Range 'Delare this at top of module

Private Sub Worksheet_SelectionChange(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

Set c = Range("A3")
If OldRng Is Nothing Then Set OldRng = c
If Not Intersect(OldRng, c) Is Nothing Then
Application.ScreenUpdating = False
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
Application.ScreenUpdating = True
End If
Set OldRng = Target
End Sub

Regards,
Greg