.Protect UserInterfaceOnly:=True deleting formulas?

[micfly]

A friend helped me with this code who is out of pocket now and maybe someone on here can help. The code was working fine until I noticed it was deleting formulas. The formulas being deleted are in protected cells out of the range the code is running in e.g. E3:E9. I'm assuming it has something to do with: Sheets("DataEntry").Protect UserInterfaceOnly:=True ??? I thought that statement would allow changes to the sheet without effecting the formulas? Here's the code:

Dim LR, i As Long, cellsToFill As Range
If Intersect(Target, Range("$Q$11:$Q$399")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
i = Target.Row
Application.EnableEvents = False
Application.ScreenUpdating = False
Sheets("DataEntry").Protect UserInterfaceOnly:=True
 
If Target.Value = "" And Target.Interior.ColorIndex = 36 Then
    MsgBox "This record was previously copied" & vbLf & _
        "to another worksheet." & vbLf & vbLf & _
        "If you are going to delete it, remember" & vbLf & _
        "to delete in the another worksheet too."
    Target.Interior.ColorIndex = 3
    GoTo getout
End If
 
Set cellsToFill = Union(Cells(i, 2), Cells(i, 3), Cells(i, 4))
 
If Target.Value = "" Then GoTo getout
If Application.CountA(cellsToFill) < 3 Then
    CreateObject("WScript.shell").popup _
        "please, fill all the required cells" & vbLf & vbLf & _
            "data will not be copied", 3, "hello"
    Target.Value = ""
GoTo getout
 
Else: Target.Interior.ColorIndex = 36
Target.Offset(, -15).Resize(, 14).Copy
 
Select Case UCase(Target.Value)
    Case [S4]
        With Sheets("MGR2")
            LR = .Cells(199, 2).End(xlUp).Row
            .Cells(LR + 1, 2).PasteSpecial
        End With
        MsgBox "the record was pasted into MGR2 sheet"
    Case [S5]
        With Sheets("MGR3")
            LR = .Cells(199, 2).End(xlUp).Row
            .Cells(LR + 1, 2).PasteSpecial
        End With
        MsgBox "the record was pasted into MGR3 sheet"
    Case [S3]
        With Sheets("MGR1")
            LR = .Cells(199, 2).End(xlUp).Row
            .Cells(LR + 1, 2).PasteSpecial
        End With
        MsgBox "the record was pasted into MGR1 sheet"
    Case [S6]
        With Sheets("MGR4")
            LR = .Cells(199, 2).End(xlUp).Row
            .Cells(LR + 1, 2).PasteSpecial
        End With
        MsgBox "the record was pasted into MGR4 sheet"
     Case Else
        Target.ClearContents
        Target.Interior.ColorIndex = xlNone
End Select
Target.Value = UCase(Target.Value)
End If
Application.CutCopyMode = False
Application.ScreenUpdating = True
getout:
Application.EnableEvents = True
 
End Sub

thx for any help

 

[xenou]

Can you confirm that cells Q11:Q399 in the data entry area are not protected.

 

[micfly]

Yes, cells Q11:Q399 are not protected. BTW, this would be the same error with the original code if I commented out the .Protect UserInterfaceOnly:=True line.

 

[xenou]

Unprotect the worksheet and tell me if it works then.

 

[micfly]

Unprotect DataEntry sheet gives run-time error with 'Target.Offset(0, -15).Resize(0, 14).Copy' highlighted.

 

[Jerry Sullivan]

Unprotect DataEntry sheet gives run-time error with 'Target.Offset(0, -15).Resize(0, 14).Copy' highlighted.

micfly, I didn't see your response to the question of whether there is any other event code running beside the Worksheet_Change code you posted.

If you got an error from trying to manually unprotect the sheet, you probably have Worksheet_SelectionChange code which might be part of the problem.

 

[micfly]

The only Worksheet_Change code on the DataEntry sheet now is what xenou wrote.
No other code is running. The only other code in the DataEntry sheet is for some command buttons. Besides that, there's this

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = True
Dim L As Long
Dim myArea As String
LR = Cells(201, "B").End(xlUp).Row
myArea = Range("$A$1:$P$" & LR).Address
ActiveSheet.PageSetup.PrintArea = myArea
Application.EnableEvents = False
ActiveSheet.PrintOut
Application.EnableEvents = True
End Sub

in ThisWorkbook.

 

[xenou]

Target.Offset(0, -15).Resize([COLOR="Red"][B]0[/B][/COLOR], 14).Copy

This would be cells B11:P11 if you had just changed Q11. I don't think Resize takes 0 as an argument:

Try:

Target.Offset(0, -15).Resize([B][COLOR="Red"]1[/COLOR][/B], 14).Copy

 

[ZVI]

Hi Micfly,

Do you have:
1. Activate / Deactivate / SelectionChange / Calculate events triggering code in DataEntry sheet’s module?
2. Any events triggering code in MGR1 ... MGR1 sheets?
3. Activate / Deactivate / SelectionChange / Calculate events triggering code in ThisWorkbook module?

For at least one Yes please share the event triggering code.

Else try loading Excel in safe mode to be sure that class event triggering code in other workbook /add-ins doesn’t play.
Quit Excel, click Start, click Run, type the command: Excel /s and then Click OK.
Load your workbook via Excel, test it and let us know what is going on in this case.

 

[micfly]

Target.Offset(0, -15).Resize([COLOR=red][B]0[/B][/COLOR], 14).Copy

This would be cells B11:P11 if you had just changed Q11. I don't think Resize takes 0 as an argument:

Try:

Target.Offset(0, -15).Resize([B][COLOR=red]1[/COLOR][/B], 14).Copy

Changed and get run-time at

[COLOR=red]Target.Interior.ColorIndex = 36[/COLOR]
Target.Offset(0, -15).Resize(1, 14).Copy

 

[micfly]

Hi Micfly,

Do you have:
1. Activate / Deactivate / SelectionChange / Calculate events triggering code in DataEntry sheet’s module?
2. Any events triggering code in MGR1 ... MGR1 sheets?
3. Activate / Deactivate / SelectionChange / Calculate events triggering code in ThisWorkbook module?

For at least one Yes please share the event triggering code.

Else try loading Excel in safe mode to be sure that class event triggering code in other workbook /add-ins doesn’t play.
Quit Excel, click Start, click Run, type the command: Excel /s and then Click OK.
Load your workbook via Excel, test it and let us know what is going on in this case.

No other events on the DataEntry sheet.

I did have

Private Sub Worksheet_Activate()
If Range("B11").Value2 = "" Then
    Range("B9").End(xlDown).Offset(1, 0).Select
Else
    Range("B10").Activate
    Range("B10").End(xlDown).Offset(1, 0).Select
End If
End Sub

on the mgr sheets but have removed that for these test.
If I open in safe mode I can enter data with no errors but at Q11 it just tabs to B12 (which is fine just no copy function).
If I click the security warning - macros & activex - enable this content, I'm back to where I was with error at 'Target.Interior.ColorIndex = 36' when tabing out of the Q cell. Also, still no date/case funtions working.