How to temporarily unprotect a sheet to allow VBA code to run and reprotect immediately, using VBA?

[Rnkhch]

Hello,

First a little background about this question. Actually this is related to and in continuation of another thread of mine (Is there any way that 'filling' can be restricted to values only and not formatting, perhaps through VBA?). So in this thread, johnnyL wrote magical code (particularly in post #95 which is marked as solution) that enabled all filling/paste/paste special/undo operations to be done without any of the formatting affected at all, and the code works beautifully in unprotected sheets. There is just a tiny issue that occurs in protected sheets and only with merged cells, and we decided to make another thread here for it to be more specific.

So basically, when I paste anything in the merged cells (i.e. M17:M36 in the other thread), I get runtime error 1004, application-defined or object-defined error which shoots to the following highlighted code:

If .MergeCells Then .UnMerge '

with the word "Unmrged" highlighted.

I have attached here a simplified version of my analysis template with johnnyL's latest code already implemented in it. I have locked/hidden all cells except the editable cells, and I have protected the sheet with the password "123456" (Analysis-template).

Of course, one possibility is to leave the sheet unlocked, but I'm worried that the students will start to mess up with the text, formulas, formatting, etc., which won't be good. But I thought of another idea, which is to momentarily unprotect the sheet and allow the particular portion of the code for merged cells to do its magic, and then immediately protect the sheet back. If the VBA experts here think this is possible, I would highly appreciate any input. Of course, if any other even better strategies (than what I thought) are possible, please share as well.

Thanks much!

 

[johnnyL]

Try the following new code:

Dim RangeSelected           As Variant
Dim PreviousRangeSelected   As Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
    Dim ForbiddenRange  As Range
'
    Set ForbiddenRange = Range("N17:O36")                                                       ' <--- set this to range of cells not allowed selecting
'
    If Not Intersect(Target, ForbiddenRange) Is Nothing Then                                    ' If cell(s) selected in the Forbidden range then ...
        MsgBox "Selecting " & Target.Address(0, 0) & " is not allowed."                         '   Warn the user, or just delete this line
        Range("M" & Target.Row).Select                                                          '   Select a cell in the M column
    End If
'
    PreviousRangeSelected = RangeSelected                                                       ' Save the previously selected range
    RangeSelected = Target.Address(0, 0)                                                        ' Save the RangeSelected
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'
    If Intersect(Target, Range("E3:E42")) Is Nothing And _
            Intersect(Target, Range("F3:F42")) Is Nothing And _
            Intersect(Target, Range("G3:G42")) Is Nothing And _
            Intersect(Target, Range("M17:M36")) Is Nothing Then Exit Sub                        ' If change is not in our monitored range, Exit Sub
'
'-----------------------------------------------------------------------------------------------
'
    Dim AddressCharacter        As Long, EndAddressRow              As Long
    Dim SelectionRow            As Long
    Dim ActiveColumnLetter      As String, LastMergedColumn         As String
    Dim EndDragColumnLetter     As String, StartDragColumnLetter    As String
    Dim SelectionAddressArray   As Variant
'
'-----------------------------------------------------------------------------------------------
'
    With Selection
        If .Count = 1 And Application.CutCopyMode = False Then                                  '   If only 1 cell has been changed by user and
'                                                                                               '           not Cut/Copy then ...
            Exit Sub                                                                            '       allow the change & Exit the Sub
        ElseIf .Count = 1 And Application.CutCopyMode = xlCopy Then                             '   ElseIf only 1 cell has been changed by user and
'                                                                                               '       Copy then ...
            With Application
                .EnableEvents = False                                                           '           Turn Events off to prevent potential code loop
                .Undo                                                                           '           Undo the change that was made by the user
'
                Target.PasteSpecial Paste:=xlPasteValues                                        '           Do the Copy/paste as pastespecial PasteValues
                .CutCopyMode = False                                                            '           Clear the clipboard & 'Marching Ants'
                .EnableEvents = True                                                            '           Turn Events back on
                Exit Sub                                                                        '           Exit the sub
            End With
        End If
'
'-----------------------------------------------------------------------------------------------
'
        If .Count > 1 Then                                                                      '   If  more than one cell is being changed then
            With Application
                On Error Resume Next                                                            '           If error occurs, ignore it & exit sub
                If .CommandBars("Standard").Controls("&Undo").List(1) = "Clear" Then Exit Sub   '           Allow multiple deletetions via the delete key
                On Error GoTo 0                                                                 '           Return error handling back to Excel
'
                If .CommandBars("Standard").Controls("&Undo").List(1) = "Paste" Or _
                        .CommandBars("Standard").Controls("&Undo").List(1) = "Paste Special" And _
                        .CutCopyMode = xlCopy Then                                              '           If Copy/paste detected then ...
'
                    .EnableEvents = False                                                       '               Turn Events off to prevent potential code loop
'
                    LastMergedColumn = Split(Selection.Address, "$")(3)                         '               Get LastMergedColumn letter
'
                    .Undo                                                                       '               Undo the change that was made by the user
'
                    If ActiveCell.MergeCells Then                                               '               If ActiveCell is merged then ...
'
' Copy/Paste to Merged cell range
'
                        EndAddressRow = Split(Selection.Address, "$")(4)                        '               Get the ending address row number
'
                        ActiveColumnLetter = Split(Cells(1, ActiveCell.Column).Address, "$")(1) '               Get ActiveColumnLetter
'
                        With Range(ActiveColumnLetter & Target.Row & ":" & _
                                ActiveColumnLetter & EndAddressRow)
                            If .MergeCells Then .UnMerge                                        '                   Unmerge the range
                        End With
'
                        Range(PreviousRangeSelected).Copy                                       '               Copy the initial selected range
                        Range(ActiveColumnLetter & Target.Row & ":" & ActiveColumnLetter & _
                                EndAddressRow).PasteSpecial Paste:=xlPasteValues                '               Paste as pastespecial PasteValues
'
                        For MergeCellCounter = Target.Row To EndAddressRow                      '               Loop through the rows of the target
                            Range(ActiveColumnLetter & MergeCellCounter & ":" & _
                                    LastMergedColumn & MergeCellCounter).Merge                  '                   Merge the Row columns
                        Next                                                                    '               Loop back
'
                        .EnableEvents = True                                                    '               Turn Events back on
                        Exit Sub                                                                '               Exit Sub
                    Else                                                                        '           Else ...
'
' Copy/Paste to UnMerged cell range
'
                        Target.PasteSpecial Paste:=xlPasteValues                                '               Do the Copy/paste as pastespecial PasteValues
                        .CutCopyMode = False                                                    '               Clear the clipboard & 'Marching Ants'
                        .EnableEvents = True                                                    '               Turn Events back on
                        Exit Sub                                                                '               Exit Sub
                    End If
                End If
'
'-----------------------------------------------------------------------------------------------
'
                If ActiveCell.MergeCells And .CommandBars("Standard").Controls("&Undo").List(1) _
                        <> "Auto Fill" And .CommandBars("Standard").Controls("&Undo").List(1) _
                        <> "Paste" Then                                                         '       If Merged cell found & we are not dragging
'                                                                                               '               or copying a cell then ...
' Standard write to single merged cell
'
                    EndAddressRow = ActiveCell.Row                                              '           Save EndAddressRow
'
                    If EndAddressRow - Target.Row = 1 Then Exit Sub                             '           Allow a single Merged cell change
'
                ElseIf ActiveCell.MergeCells And .CommandBars("Standard").Controls("&Undo").List(1) _
                        = "Auto Fill" Or ActiveCell.MergeCells And _
                        .CommandBars("Standard").Controls("&Undo").List(1) = "Paste" Then       '       Else if Dragging or pasting to merged cell then ...
'
' Dragging Merged Cell or pasting to merged cell
'
                    .EnableEvents = False                                                       '           Turn Events off to prevent potential code loop
'
                    SelectionAddressArray = Split(Selection.Address(0, 0), ":")                 '           Separate Address Range into
'                                                                                               '               SelectionAddressArray
                    .Undo                                                                       '           Undo the change that was made by the user
'
                    Range(SelectionAddressArray(0) & ":" & _
                            SelectionAddressArray(1)).FormulaR1C1 = Selection.Cells(1)          '           Make the user changes without affecting format
                    .EnableEvents = True                                                        '           Turn Events back on
                    Exit Sub                                                                    '           Exit the sub
                End If
'
'-----------------------------------------------------------------------------------------------
'
                SelectionRow = Selection.Row                                                    '           Save the Selection.Row into SelectionRow...24
'
                EndDragColumnLetter = Split(Selection.Address, "$")(3)                          '           Get EndDragColumnLetter
                StartDragColumnLetter = Split(Cells(1, ActiveCell.Column).Address, "$")(1)      '           Get StartDragColumnLetter
'
                .EnableEvents = False                                                           '           Turn Events off to prevent potential code loop
'
                SelectionAddressArray = Split(Selection.Address(0, 0), ":")                     '           Separate Address Range into
'                                                                                               '               SelectionAddressArray
                .Undo                                                                           '           Undo the change that was made by the user
'
                If SelectionRow = ActiveCell.Row Then                                           '           If Dragging down then ...
                    Range(SelectionAddressArray(0) & ":" & EndDragColumnLetter & _
                            ActiveCell.Row).AutoFill Destination:=Range(SelectionAddressArray(0) & _
                            ":" & SelectionAddressArray(1)), Type:=xlFillValues                 '               Make the user changes without affecting format
                Else                                                                            '           Else ...
                    Range(StartDragColumnLetter & ActiveCell.Row & ":" & EndDragColumnLetter & _
                            ActiveCell.Row).AutoFill Destination:=Range(SelectionAddressArray(1) & _
                            ":" & SelectionAddressArray(0)), Type:=xlFillValues                 '               Make the user changes without affecting format
                End If
'
                .EnableEvents = True                                                            '           Turn Events back on
            End With
        End If
    End With
End Sub

When a cell is selected in N17:O36 range, a pop up will occur and then a cell in the M column will be selected. You can delete the line for the pop up box if you want to.

 

[Rnkhch]

OMG, that is marvelous!! That's exactly what I wanted! You are truly the absolute number one genius!

I guess that completes this phase of the development of my project, and thanks for all your help along

I marked your post #31 as solution
P.S.
To make you more intrigued, I'm constantly adding other features to my application, and one is an export/import feature in my other thread which is in the works and looks super cool so far.

And I'll make new posts for other features later, so I look forward to collaborating with you again soon so flies will keep coming