.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]

All I can think is that protection is a problem somehow, that this cell is protected even though you think it isn't.


For kicks try:

ActiveSheet.Unprotect
Target.Interior.ColorIndex = 36

If you are using a password with your protection include the password:

ActiveSheet.Unprotect "mypassword"
Target.Interior.ColorIndex = 36

 

[micfly]

Okay, I've double checked and they are not protected. As a final test I cleared every piece of code in the workbook/sheets except your work_sheet code you wrote in the DataEntry sheet. Adding the line you suggested

ActiveSheet.Unprotect
Target.Interior.ColorIndex = 36

I get an error with

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

this highlighted now.

So I tried

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

No errors and it copied the row to the correct sheet but then I checked the formula in E3 and it was gone.

 

[xenou]

Try this:

ActiveSheet.Unprotect
Target.Interior.ColorIndex = 36
ActiveSheet.Protect

If we are lucky, it will crash when it tries to delete E3. Be sure to put the formula back in E3 first. What is that formula?

 

[micfly]

Okay, using

ActiveSheet.Unprotect
Target.Interior.ColorIndex = 36
ActiveSheet.Protect

That works! The formulas in E3 is: =SUMPRODUCT(--(E11:E399="N"),--(F11:F399<>"L"))

Only one problem now, the date and case formats aren't working.

 

[xenou]

Wonderful. I'll have to check back later. How many bugs can there be in 20 lines of code?

 

[micfly]

You've been very patient...thx for helping!

 

[xenou]

Hmmm. Looking back at this "fix"

ActiveSheet.Unprotect
Target.Interior.ColorIndex = 36
ActiveSheet.Protect

The fact that Protect the sheet means your formula doesn't get deleted means that you have some code somewhere that deletes the formula (otherwise). This is probably bad code - there should be no reason to try to delete anything in cell E3, as far as I can tell from your posts.

I'm not sure why the formatting in the other cells doesn't work. That should be easy to debug - just enter a value and set a breakpoint to see what the code is actually doing.

Debugging tips:
http://krgreenlee.blogspot.com/2006/04/programming-excel-vba-debugging-for.html

You seem a little in over your head with programming data entry forms - maybe just enter the data on the appropriate sheets and forget about shuffling it from the "data entry" form.

 

[ZVI]

...Only one problem now, the date and case formats aren't working...

Rebuild the code as follows:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim conVal As String
  Dim LR, i As Long, cellsToFill As Range

  If Target.Cells.Count > 1 Then Exit Sub

  'On Error GoTo getout '//COMMMENT OUT THIS LINE WHILE TESTING
  Application.EnableEvents = False

  Select Case Target.Column

    '----------------------------------------------------
    'COLUMN C
    'allow the user to enter 010109 or 01/01/09 as a date
    Case 3
      If IsDate(Target.Value) Then
        Rem do nothing
      Else
        conVal = Format(Target.Value, "000000")
        conVal = Mid(conVal, 1, 2) & "/" & Mid(conVal, 3, 2) & "/" & Mid(conVal, 5, 2)
        If IsDate(conVal) Then
          Target.Value = conVal
        Else
          ' .Value = vbNullString
        End If
      End If

    '-------------------------------------
    'COLUMNS B, J
    'convert to proper case - columns B, J
    Case 2, 10
      Target.Value = StrConv(Target.Text, vbProperCase)


    '-------------------------------------
    'COLUMNS E, F, G
    'convert to upper case
    Case 5, 6, 7
      Target.Value = StrConv(Target.Text, vbUpperCase)


    '-----------------------------------------------------------
    'Column Q
    'code to copy records inserted in this worksheet (DataEntry)
    'and paste into the corresponding FIMGR worksheet - nov/2011
    Case 17
      If Not Intersect(Target, Range("$Q$11:$Q$399")) Is Nothing Then
        i = Target.Row 
        ' ...
        ' Place the updated code for Q11:Q399 here
        ' ...
        Target.Value = UCase(Target.Value)
      End If
  End Select

getout:
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
  Application.EnableEvents = True

End Sub

 

[micfly]

Hmmm. Looking back at this "fix"

Thanks for the tips. This makes no sense to me as none of these cells are protected anyway and I do not lose any formulas when this code isn't running??? And, yes, definitly over my head on the coding part. But I put a lot of work into this. I just counted, apprx. 180 formulas on this sheet looking at that one row of data to calculate totals, avearges, comparisons and run reports. So who knows???

 

[micfly]

Rebuild the code as follows:

    Target.Value = StrConv(Target.Text, vbProperCase)

Get error on this line.