ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   insert row when cell full, auto wrap (https://www.excelbanter.com/excel-programming/438034-insert-row-when-cell-full-auto-wrap.html)

Tim

insert row when cell full, auto wrap
 
Hi there,
I used this code in ver 2003 to insert a row and wrap text in a cell..BUT,
it does not work in ver 2007. Any ideas? Much appreciated.

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

With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
Application.ScreenUpdating = True
End If
End With
End Sub


Gord Dibben

insert row when cell full, auto wrap
 
That code does not insert a row nor does it set a cell to wrap text.

All it does is allow autofitting rows with merged cells.

Cells must be preset to "Wrap Text"

Rows must to preset to "Autofit"

Then and only then will the merged cells autofit.


Gord Dibben MS Excel MVP

On Tue, 5 Jan 2010 15:16:02 -0800, Tim
wrote:

Hi there,
I used this code in ver 2003 to insert a row and wrap text in a cell..BUT,
it does not work in ver 2007. Any ideas? Much appreciated.

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

With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
Application.ScreenUpdating = True
End If
End With
End Sub




All times are GMT +1. The time now is 11:09 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com