View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
stefan via OfficeKB.com stefan via OfficeKB.com is offline
external usenet poster
 
Posts: 18
Default Wrap Text in Merged Cell

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