Merging adjacent unlocked cells in a protected sheet

Topic

New Reply

I use an Excel spreadsheet for daily reporting of lithology in a strip mining site. The sheet has fields used as checkboxes, with accompanying labeling. The top of the sheet is just date and location (using coordinates) fields, and the right half of the sheet consists of labeled checkboxes. The left half of the sheet is used for describing the lithology at the time of the inspection.

I have all the fields used for labeling locked, and the sheet protected, so that the only fields that can be selected are the fields that actually need input. The problem I’ve encountered is in the open field for lithology. Depending on the lithology, this field is usually divided into from 3 to 5 strata, with descriptions.

Ideally, I want to select the depth of the field (in rows), merge all those cells and type in a description centered horizontally and vertically, and delineate the lower boundary of the field with a thick border. However, when I select the desired area and try to format, the “Merge cells” checkbox is filled with a black rectangle, greyed out, and can’t be selected. I can mark the lower boundary with a thick border, but I can’t merge the cells.

If I unprotect the sheet, I can merge the cells. But protected, even though all those cells are unlocked, I can’t merge them. What am I overlooking?

Always create a fresh drive image before making system changes/Windows updates; you may need to start over!

We all have our own reasons for doing the things that we do with our systems; we don't need anyone's approval, and we don't all have to do the same things.

We were all once "Average Users".

Computer Specs

Reply | Quote

Replies

Bruce,

I think that’s just one of those things you can’t do if the sheet is protected. What I’d do is write a macro and assign a shortcut to it as follows:
Unprotect sheet
Merge selected cells
Protect sheet

Code:

Option Explicit

Sub MergeCells()
    
    ActiveSheet.Unprotect
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    
End Sub

HTH :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Doh!

Turns out to have been extremely simple. In the “Format Cells” Number tab, I changed the Category from “General” to “Text”. Works like a charm, now.

Reminds me of the words of wisdom I received from my first superintendent after I had been promoted to supervisor. “When you’re troubleshooting, start with the simple and proceed to the complex.”

Always create a fresh drive image before making system changes/Windows updates; you may need to start over!

We all have our own reasons for doing the things that we do with our systems; we don't need anyone's approval, and we don't all have to do the same things.

We were all once "Average Users".

Computer Specs

Reply | Quote

Doh!

Is right who would have thunk! :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Double Doh!!:o:

I had the sheet unprotected without realizing it. Protected the sheet, and it did not work!

I started over with your macro, Bruce, and did some editing to get the look I want.

Code:

Sub MergeCells()
‘
‘ Descriptions Macro
‘ Lithology Description
‘
‘ Keyboard Shortcut: Ctrl+k
‘
  
    ActiveSheet.Unprotect
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    
End Sub

Then, using your macro again as a start, I wrote a second macro to leave the bottom of the field open.

Code:

Sub Bottom()
‘
‘ Bottom Macro
‘ Bottom Description
‘
‘ Keyboard Shortcut: Ctrl+b
‘
 
    ActiveSheet.Unprotect
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    
End Sub

I may neaten that up a little bit, but the sheet is doing what I want it to do now. Thanks Bruce!:clapping:

Always create a fresh drive image before making system changes/Windows updates; you may need to start over!

We all have our own reasons for doing the things that we do with our systems; we don't need anyone's approval, and we don't all have to do the same things.

We were all once "Average Users".

Computer Specs

Reply | Quote