Wrap Text in Merged Cell

[stefan via OfficeKB.com]

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

 

[Norman Jones]

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

 

[stefan via OfficeKB.com]

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]

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

 

[stefan via OfficeKB.com]

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]

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'.

 

[stefan via OfficeKB.com]

Hi Norman,
I appreciate the info and help.
I too like the 'Center across selection' better then merging. I'd really like
it if there would be a 'Left across selection' or 'Right across selection'
option.

I put together a "Service Form" and C30:F40 are individually used cells
whereas the ranges next to them G30:G40 are a mix of merge and 'Center across
selection' . Range G40:H40 is one that the user may choose to insert more
data then it would fit to be visible and hence i found the workaround with
"autofitting the merged cells" great.

Another question...or so...
My range G40 (G40:H40) is one that changes, depending on how many cells the
user uses/inserts above. I changed the code to
Set OldRng = Union(Range("C22").MergeArea, _
Range("Commentrange").MergeArea) ' Was G40
Set AutoFitRng = Union(Range("C22:H22"), _
Range("Commentrange")) ' WasG40:H40
which seems to be working just fine. Do you see anything that would cause me
trouble, that may have not shown up when testing it so far?

And to the formatting "wrap". Yes, i too fell in that hole once i got a bit
frustrated that the code, which worked on one range, did not work on the
second, until i figured that the cells were not even set for "wrap".

Thank you,

Stefan

 

[Norman Jones]

Hi Stefan,

Replacing a hard coded range with a named range should cause no problem and,
in my opinion, increases flexibility.

As I avoid the use of merged cells, I have no experience of using similar
code and could not, therefore, comment on what problems you might encounter.

I am aware that merged cells are subject to a number of problems and
restrictions, which is why I don't use them.

I would suggest you make a Google search for 'Merged Cells' and see if any
of the reported problems could have an impact on your workbook and your
code.