PDA

View Full Version : [SOLVED] Unprotect a merged cell



oam
09-11-2014, 03:49 PM
I am using the code below on a protected worksheet to adjust a row based on the amount of data that is entered into the merged cell, the code works well except for it changes the Format Cell – Protection to blackout and protects the merged cell where the data is entered and the user cannot enter data in the merged cell.
What I need is a code that will adjust the row height based on the data entered into the cell and not protect the merged cell.

Thank you for all your help.





Sub AutoFitMergedCellRowHeight()
ActiveSheet.Unprotect
Dim cel As Range
For Each cel In Sheets("Weekly Report Worksheet").Range("B16") ',D1,A5,D5
AFMCRH cel
Next cel
End Sub
Sub AFMCRH(cel As Range)
Dim MergedHeight As Single
Dim MergedWidth As Single
Dim PossNewRowHeight As Single
Dim lngRowCount As Long
Dim lngColCount As Long
Dim i As Long
Dim celWidth As Single
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If cel.MergeCells Then
With cel.MergeArea
If .WrapText = True Then
lngRowCount = .Rows.Count
lngColCount = .Columns.Count
MergedHeight = Selection.Height
For i = 1 To lngColCount
MergedWidth = .Cells(1, i).ColumnWidth + 1 + MergedWidth
Next i
celWidth = cel.ColumnWidth
.MergeCells = False
.Cells(1).RowHeight = MergedHeight
.Cells(1).ColumnWidth = MergedWidth
.EntireRow.AutoFit
PossNewRowHeight = .Cells(1).RowHeight
.MergeCells = True
.Cells(1).ColumnWidth = celWidth
For i = 1 To lngRowCount
.Cells(i, 1).RowHeight = PossNewRowHeight / lngRowCount
Next i
End If
End With
End If
ActiveSheet.Protect

End Sub

p45cal
09-12-2014, 02:04 AM
With each merged area, select it, unmerge, unlock, wrap text, re-merge. This is so that all the cells in the merged area are unlocked and wrapped.

On another matter, the line:
MergedHeight = Selection.Height
might cause problems, especially if you're processing several merged areas ie. you change one line in the calling sub to:
For Each cel In Sheets("Weekly Report Worksheet").Range("B16 ,D1,A5,D5")
I'm not sure what the intention is but perhaps change that line to:
MergedHeight = .Height

oam
09-15-2014, 04:27 PM
p45cal:

I did as you instructed with "With each merged area, select it, unmerge, unlock, wrap text, re-merge" but this did not prevent the cell from going from Unprotected to Protected when the code is run.

Also, the line of code "For Each cel In Sheets("Weekly Report Worksheet").Range("B16 ',D1,A5,D5")" actually has a " ' " in the line so the ",D1,A5,D5" not used.

Thank you for your help but I found a different solution to my problem, I made a (a ghost/shadow sheet is a sheet that is linked to a worksheet and is hidden and unprotected) shadow sheet that works well for my needs.
I know working with merged cell is not recommended by everyone on the forum but this works for me and work-around with the shadow sheet works.

Thank you again for all your help.