Hello,
Ich have a merged cell "C22" which spans over columns C:H in row 22.
Contracry to single cells, when the text wraps, the cell height does not
adjust automatically. Actually, does not even adjust when you click between
the row headers. One has to drag it to fit. Is there a workaround, something
that can be embedded into a Worksheet_Change option or so?
Thank you for your help.
Stefan


--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200507/1

Hi Stefan,

See the following post from Jim Rech (last post in the thread):

http://tinyurl.com/738dd

Also see the following post from Greg Wilson (Post 2):

http://tinyurl.com/cqhwl

---
Regards,
Norman



"stefan via OfficeKB.com" wrote in message
...
Hello,
Ich have a merged cell "C22" which spans over columns C:H in row 22.
Contracry to single cells, when the text wraps, the cell height does not
adjust automatically. Actually, does not even adjust when you click
between
the row headers. One has to drag it to fit. Is there a workaround,
something
that can be embedded into a Worksheet_Change option or so?
Thank you for your help.
Stefan


--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200507/1

Hi Norman,
Thank you for the URL's.
Of course, after i posted i found some helpful ones too.
One post was also from Greg Wilson, which i modified to my needs. See below.
Now that i see that this works so great i would like to have a second range
(G:H40) included and have not been successful doing so. Would you have a hint?

Thank you,
Stefan

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim RowHt As Single, MergeWidth As Single
Dim C As Range, AutoFitRng As Range
Dim CWidth As Single, NewRowHt As Single
Static OldRng As Range
On Error Resume Next
If OldRng Is Nothing Then _
Set OldRng = Range("C22").MergeArea
Set AutoFitRng = Range("C22:H22")
If Not Intersect(OldRng, AutoFitRng) Is Nothing Then
Application.ScreenUpdating = False
With OldRng
RowHt = .RowHeight
CWidth = .Cells(1).ColumnWidth
For Each C In OldRng
MergeWidth = C.ColumnWidth + MergeWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergeWidth
.EntireRow.AutoFit
NewRowHt = .RowHeight
.Cells(1).ColumnWidth = CWidth
.MergeCells = True
.RowHeight = NewRowHt
End With
Application.ScreenUpdating = True
End If
Set OldRng = Target
End Sub


Norman Jones wrote:
Hi Stefan,

See the following post from Jim Rech (last post in the thread):

http://tinyurl.com/738dd

Also see the following post from Greg Wilson (Post 2):

http://tinyurl.com/cqhwl

---
Regards,
Norman


--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200507/1

Hi Stefan,

Try :

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim RowHt As Single, MergeWidth As Single
Dim C As Range, AutoFitRng As Range
Dim CWidth As Single, NewRowHt As Single
Static OldRng As Range
On Error Resume Next
If OldRng Is Nothing Then _
Set OldRng = Union(Range("C22").MergeArea, _
Range("G40").MergeArea) '<<====== CHANGED
Set AutoFitRng = Union(Range("C22:H22"), _
Range("G40:H40")) '<<====== CHANGED
If Not Intersect(OldRng, AutoFitRng) Is Nothing Then
Application.ScreenUpdating = False
With OldRng
RowHt = .RowHeight
CWidth = .Cells(1).ColumnWidth
For Each C In OldRng
MergeWidth = C.ColumnWidth + MergeWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergeWidth
.EntireRow.AutoFit
NewRowHt = .RowHeight
.Cells(1).ColumnWidth = CWidth
.MergeCells = True
.RowHeight = NewRowHt
End With
Application.ScreenUpdating = True
End If
Set OldRng = Target
End Sub

---
Regards,
Norman



"stefan via OfficeKB.com" wrote in message
...
Hi Norman,
Thank you for the URL's.
Of course, after i posted i found some helpful ones too.
One post was also from Greg Wilson, which i modified to my needs. See
below.
Now that i see that this works so great i would like to have a second
range
(G:H40) included and have not been successful doing so. Would you have a
hint?

Thank you,
Stefan

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim RowHt As Single, MergeWidth As Single
Dim C As Range, AutoFitRng As Range
Dim CWidth As Single, NewRowHt As Single
Static OldRng As Range
On Error Resume Next
If OldRng Is Nothing Then _
Set OldRng = Range("C22").MergeArea
Set AutoFitRng = Range("C22:H22")
If Not Intersect(OldRng, AutoFitRng) Is Nothing Then
Application.ScreenUpdating = False
With OldRng
RowHt = .RowHeight
CWidth = .Cells(1).ColumnWidth
For Each C In OldRng
MergeWidth = C.ColumnWidth + MergeWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergeWidth
.EntireRow.AutoFit
NewRowHt = .RowHeight
.Cells(1).ColumnWidth = CWidth
.MergeCells = True
.RowHeight = NewRowHt
End With
Application.ScreenUpdating = True
End If
Set OldRng = Target
End Sub


Norman Jones wrote:
Hi Stefan,

See the following post from Jim Rech (last post in the thread):

http://tinyurl.com/738dd

Also see the following post from Greg Wilson (Post 2):

http://tinyurl.com/cqhwl

---
Regards,
Norman


--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200507/1

Hi Norman,
This is genius. And so simple, if you know how to do it. Thank you so much.
Hey, i assume that you can have has many ranges as you want or is there a
limitation? Not that i'd need it (now), just wondering.
Thank you,
Stefan

Norman Jones wrote:
Hi Stefan,

Try :

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim RowHt As Single, MergeWidth As Single
Dim C As Range, AutoFitRng As Range
Dim CWidth As Single, NewRowHt As Single
Static OldRng As Range
On Error Resume Next
If OldRng Is Nothing Then _
Set OldRng = Union(Range("C22").MergeArea, _
Range("G40").MergeArea) '<<====== CHANGED
Set AutoFitRng = Union(Range("C22:H22"), _
Range("G40:H40")) '<<====== CHANGED
If Not Intersect(OldRng, AutoFitRng) Is Nothing Then
Application.ScreenUpdating = False
With OldRng
RowHt = .RowHeight
CWidth = .Cells(1).ColumnWidth
For Each C In OldRng
MergeWidth = C.ColumnWidth + MergeWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergeWidth
.EntireRow.AutoFit
NewRowHt = .RowHeight
.Cells(1).ColumnWidth = CWidth
.MergeCells = True
.RowHeight = NewRowHt
End With
Application.ScreenUpdating = True
End If
Set OldRng = Target
End Sub

---
Regards,
Norman


--
Message posted via http://www.officekb.com

Hi Stefan,

I see no intrinsic reason why this could not be extended to cover numerous
ranges.

If you had a number of merged ranges, for ease of maintenance and clarity, I
would use a form like:

Set Rng1 = Range(...).MergeArea
Set Rng2 = Range(...).MergeArea
.....
.....
Set RngN = Range(...).MergeArea


set OldRng =Union(Rng1,rng2....rngN)

That said, you did note Jim Rech's instruction about ensuring to set the
wrap format ? In testing, if I didn't, I got a painful kick!

Whilst you appear very happy, I should tell you that I abhor merged cells
and never use them. Where I might otherwise use merged cells, I use 'Center
across selection'.

---
Regards,
Norman



"stefan via OfficeKB.com" wrote in message
...
Hi Norman,
This is genius. And so simple, if you know how to do it. Thank you so
much.
Hey, i assume that you can have has many ranges as you want or is there a
limitation? Not that i'd need it (now), just wondering.
Thank you,
Stefan

Norman Jones wrote:
Hi Stefan,

Try :

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim RowHt As Single, MergeWidth As Single
Dim C As Range, AutoFitRng As Range
Dim CWidth As Single, NewRowHt As Single
Static OldRng As Range
On Error Resume Next
If OldRng Is Nothing Then _
Set OldRng = Union(Range("C22").MergeArea, _
Range("G40").MergeArea) '<<====== CHANGED
Set AutoFitRng = Union(Range("C22:H22"), _
Range("G40:H40")) '<<====== CHANGED
If Not Intersect(OldRng, AutoFitRng) Is Nothing Then
Application.ScreenUpdating = False
With OldRng
RowHt = .RowHeight
CWidth = .Cells(1).ColumnWidth
For Each C In OldRng
MergeWidth = C.ColumnWidth + MergeWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergeWidth
.EntireRow.AutoFit
NewRowHt = .RowHeight
.Cells(1).ColumnWidth = CWidth
.MergeCells = True
.RowHeight = NewRowHt
End With
Application.ScreenUpdating = True
End If
Set OldRng = Target
End Sub

---
Regards,
Norman


--
Message posted via http://www.officekb.com