resultsman
New Member
- Joined
- Jul 2, 2014
- Messages
- 2
Hi,
I have an unlocked merged cell that I want to automatically Autofit when multiple lines of text are added. The code below does that but for some reason changes the protection so that all but the 1st cell are locked resulting in the merged cell being locked. When I protect the workbook and only allow the user to only select unlocked cells, then they can type in the merged cell but if they try to go back to it, they can't. I need the merged cell to remain unlocked so the user can go back to it at any time. I am using Excel 2010 on Windows 7. Your assistance is most appreciated.
<TBODY>
</TBODY>
I have an unlocked merged cell that I want to automatically Autofit when multiple lines of text are added. The code below does that but for some reason changes the protection so that all but the 1st cell are locked resulting in the merged cell being locked. When I protect the workbook and only allow the user to only select unlocked cells, then they can type in the merged cell but if they try to go back to it, they can't. I need the merged cell to remain unlocked so the user can go back to it at any time. I am using Excel 2010 on Windows 7. Your assistance is most appreciated.
Option Explicit Option Base 1 ________________________________________ Sub FixMerged(PickArray As Integer) Dim mw As Single Dim cM As Range Dim rng As Range Dim cw As Double Dim rwht As Double Dim ar As Variant Dim i As Integer Application.ScreenUpdating = False ar = Array("A25", "B25", "C25", "D25", "E25", "F25", "G25", "H25") For i = 1 To UBound(ar) On Error Resume Next Set rng = Range(Range(ar(i)).MergeArea.Address) With rng .MergeCells = False cw = .Cells(1).ColumnWidth mw = 0 For Each cM In rng cM.WrapText = True mw = cM.ColumnWidth + mw Next mw = mw + rng.Cells.Count * 0.66 .Cells(1).ColumnWidth = mw .EntireRow.AutoFit rwht = .RowHeight .Cells(1).ColumnWidth = cw .MergeCells = True .RowHeight = rwht End With Next i Application.ScreenUpdating = True End Sub ________________________________________ Private Sub Worksheet_Change(ByVal Target As Range) Dim PickAR As Integer If Not Intersect(Target, Range("A25, B25, C25, D25, E25, F25, G25, H25")) Is Nothing Then PickAR = 1 FixMerged (PickAR) End If End Sub |
<TBODY>
</TBODY>