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