Run Time Error 1004
I have the following code ina worksheet that wraps text in merged cells. I
also have some links from one cell to another to avoid entering text twice. When I protect the sheet and try to enter text into the cell, I get the Run Time error message 1004. I get an option to end or debug. If I debug, it takes to the line in the code: ma.MergeCells = False I can click on End and then everything is OK. How do I modify the code so I don't get the error please? Thanks, Gary 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 |
Run Time Error 1004
I don't know what's up with .MergeCells=False, it worked fine in a simple
test I just ran. OT: Instead of this: For Each cc In ma.Cells MrgeWdth = MrgeWdth + cc.ColumnWidth Next why not use MrgeWdth = ma.Width? - Jon ------- Jon Peltier, Microsoft Excel MVP Tutorials and Custom Solutions http://PeltierTech.com _______ "gwinder" wrote in message ... I have the following code ina worksheet that wraps text in merged cells. I also have some links from one cell to another to avoid entering text twice. When I protect the sheet and try to enter text into the cell, I get the Run Time error message 1004. I get an option to end or debug. If I debug, it takes to the line in the code: ma.MergeCells = False I can click on End and then everything is OK. How do I modify the code so I don't get the error please? Thanks, Gary 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 10:05 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com