.Protect UserInterfaceOnly:=True deleting formulas?

M

micfly

Well-known Member
Joined
Sep 8, 2008
Messages
543
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:

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
 
Sort by date Sort by votes

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
xenou said:
Okay, back to the beginning:

1) Your code has an End Sub but not a Start. I am assuming that this is a change event. Can you confirm that? If you are not sure, post the complete code with the beginning of the sub.
Click to expand...

Sorry, yes, this is a change event. I'm not getting any errors just the problem with the formulas being deleted.
I'll paste the rest of the code..

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
' this allows the user to enter 010109 or 01/01/09 as a date
' format cells as "TEXT" for this to work
 
    Dim conVal As String
 
    With Target
        If .Cells.Count = 1 And .Column = 3 Then
            If IsDate(.Value) Then
                Rem do nothing
            Else
                conVal = Format(.Value, "000000")
                conVal = Mid(conVal, 1, 2) & "/" & Mid(conVal, 3, 2) & "/" & Mid(conVal, 5, 2)
                Application.EnableEvents = False
                If IsDate(conVal) Then
                    .Value = conVal
                Else
                    ' .Value = vbNullString
                End If
                Application.EnableEvents = True
            End If
        End If
    End With
    ' Then the cases below
 
    If Target.Cells.Count = 1 Then
        On Error GoTo ErrHandler
        Application.EnableEvents = False
        If Not IsNumeric(Target.Value) Then
            If Not Application.Intersect(Me.Range("B11:B399,J11:J399"), Target) Is Nothing Then
                Target.Value = StrConv(Target.Text, vbProperCase)
            ElseIf Not Application.Intersect(Me.Range("E11:E399,F11:F399,G11:G399"), Target) Is Nothing Then
                Target.Value = StrConv(Target.Text, vbUpperCase)
            End If
        End If
    End If
ErrHandler:
    Application.EnableEvents = True
 
'CODE TO COPY RECORDS INSERTED IN THIS WORKSHEET (DataEntry)
'AND PASTE INTO THE CORRESPONDING "FIMGR" WORKSHEET - nov/2011
'==============================================================
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
'check if the record was already processed (copied & pasted)
'and now it´s going to be deleted (intentionally or not)
'the FIMGR cell will turn red until the record is settled
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
'list of cells to check if they are filled before copy & paste
Set cellsToFill = Union(Cells(i, 2), Cells(i, 3), Cells(i, 4))
'check number of filled cells: if it's less than the list number
'then a MsgBox is showed (for 3 sec), the entry is deleted and exit sub
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
'if all is OK then start copy & paste;
'first change collor of FIMGR cell to yellow, copy the record
Else: Target.Interior.ColorIndex = 36
Target.Offset(, -15).Resize(, 14).Copy
'read who is the FIMGR and paste to the corresponding sheet
Select Case UCase(Target.Value)
    Case [S4]
        With Sheets("MGR2")
            LR = .Cells(199, 2).End(xlUp).Row
            .Cells(LR + 1, 2).PasteSpecial (xlPasteValues)
        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 (xlPasteValues)
        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 (xlPasteValues)
        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 (xlPasteValues)
        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
 
Upvote 0
When you make the change on sheet data entry, what cell is the change being made in? And what do you change (i.e., what do you type into the cell?). And exactly what cells are being deleted as a results that should not be deleted (on the same data entry sheet)?

This reminds me of a cartoon where some tells a few programmers that the coke machine doesn't work ... they start asking a bazillion questions such as "did you put dollars or coins in the machine?" "where were you standing?" "What time was it?" And oh yeah, of course ... "was it plugged in?"
 
Last edited:
Upvote 0
Here’s an example snap shot: http://home.windstream.net/mcfly/tmp/Example.jpg
All the sheets look the same except the MGR sheets do not have the Q column.
All the data is entered on the DatEntry sheet and then pasted accordingly to the other sheets.
The change is made at the last entry in the Q cell. When you tab out of the Q cell the row of data gets pasted to the corresponding sheet.

After a few entries the formulas start to disappear. These formulas are all across the top of the sheet and below row 400. All of the cells are protected (where the formulas are) except where the data is entered (B11:O399).
There are no formulas where the data is entered. There are some data validation lists in some of the data entry cells. Also a little code (See attached code) to help with streamlining date entry and cases but thats it.
And yes, it's plugged in :)
 
Upvote 0
I think the patch jobs have made your code a bit confusing. Best thing I think is a rewrite. Try this and see if it works (note that I have commented out the error handler. We want the program to crash if it errors - that's how you find out where the error is).

My strategy is that since the code assumes and runs only when one one cell is changed, we only need to figure out two things - 1) are they in the data entry areas, and 2) if so, what column are they in. So we just organize the code by testing for the columns and taking the right action depending on what column they are in.

JS - why didn't you beat me to this. Sigh. Spent an hour rewriting this...I blame you. ;)

Code: 
[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]Dim[/COLOR] conVal [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] LR, i [COLOR="Navy"]As[/COLOR] Long, cellsToFill [COLOR="Navy"]As[/COLOR] Range
    
    
    [COLOR="Navy"]If[/COLOR] (Target.Cells.Count = 1) _
        [COLOR="Navy"]And[/COLOR] _
        (Not Intersect(Target, Range("$Q$11:$Q$399")) [COLOR="Navy"]Is[/COLOR] Nothing) [COLOR="Navy"]Then[/COLOR]
        
        [COLOR="SeaGreen"]'On Error GoTo getout '//COMMMENT OUT THIS LINE WHILE TESTING[/COLOR]
        Application.EnableEvents = False
        
        [COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] Target.Column
        
            [COLOR="SeaGreen"]'----------------------------------------------------[/COLOR]
            [COLOR="SeaGreen"]'COLUMN C[/COLOR]
            [COLOR="SeaGreen"]'allow the user to enter 010109 or 01/01/09 as a date[/COLOR]
            [COLOR="Navy"]Case[/COLOR] 3
                [COLOR="Navy"]If[/COLOR] IsDate(Target.Value) [COLOR="Navy"]Then[/COLOR]
                    Rem do nothing
                [COLOR="Navy"]Else[/COLOR]
                    conVal = Format(Target.Value, "000000")
                    conVal = Mid(conVal, 1, 2) & "/" & Mid(conVal, 3, 2) & "/" & Mid(conVal, 5, 2)
                    [COLOR="Navy"]If[/COLOR] IsDate(conVal) [COLOR="Navy"]Then[/COLOR]
                        Target.Value = conVal
                    [COLOR="Navy"]Else[/COLOR]
                        [COLOR="SeaGreen"]' .Value = vbNullString[/COLOR]
                    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
                [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
            
            [COLOR="SeaGreen"]'-------------------------------------[/COLOR]
            [COLOR="SeaGreen"]'COLUMNS B, J[/COLOR]
            [COLOR="SeaGreen"]'convert to proper case - columns B, J[/COLOR]
            [COLOR="Navy"]Case[/COLOR] 2, 10
                Target.Value = StrConv(Target.Text, vbProperCase)
        
            
            [COLOR="SeaGreen"]'-------------------------------------[/COLOR]
            [COLOR="SeaGreen"]'COLUMNS E, F, G[/COLOR]
            [COLOR="SeaGreen"]'convert to upper case[/COLOR]
            [COLOR="Navy"]Case[/COLOR] 5, 6, 7
                Target.Value = StrConv(Target.Text, vbUpperCase)


            [COLOR="SeaGreen"]'-----------------------------------------------------------[/COLOR]
            [COLOR="SeaGreen"]'Column Q[/COLOR]
            [COLOR="SeaGreen"]'code to copy records inserted in this worksheet (DataEntry)[/COLOR]
            [COLOR="SeaGreen"]'and paste into the corresponding FIMGR worksheet - nov/2011[/COLOR]
            [COLOR="Navy"]Case[/COLOR] 17
                    
                i = Target.Row
                [COLOR="SeaGreen"]'check if the record was already processed (copied & pasted)[/COLOR]
                [COLOR="SeaGreen"]'and now it´s going to be deleted (intentionally or not)[/COLOR]
                [COLOR="SeaGreen"]'the FIMGR cell will turn red until the record is settled[/COLOR]
                [COLOR="Navy"]If[/COLOR] Target.Value = "" [COLOR="Navy"]And[/COLOR] Target.Interior.ColorIndex = 36 [COLOR="Navy"]Then[/COLOR]
                    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
                    [COLOR="Navy"]GoTo[/COLOR] getout
                [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
                
                [COLOR="SeaGreen"]'list of cells to check if they are filled before copy & paste[/COLOR]
                [COLOR="Navy"]Set[/COLOR] cellsToFill = Union(Cells(i, 2), Cells(i, 3), Cells(i, 4))
                
                [COLOR="SeaGreen"]'check number of filled cells: if it's less than the list number[/COLOR]
                [COLOR="SeaGreen"]'then a MsgBox is showed (for 3 sec), the entry is deleted and exit sub[/COLOR]
                [COLOR="Navy"]If[/COLOR] Target.Value = "" [COLOR="Navy"]Then[/COLOR]
                    [COLOR="Navy"]GoTo[/COLOR] getout
                [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
                
                [COLOR="Navy"]If[/COLOR] Application.CountA(cellsToFill) < 3 [COLOR="Navy"]Then[/COLOR]
                    CreateObject("WScript.shell").popup _
                        "please, fill all the required cells" & vbLf & vbLf & _
                            "data will not be copied", 3, "hello"
                    Target.Value = ""
                    [COLOR="Navy"]GoTo[/COLOR] getout
                [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
                
                [COLOR="SeaGreen"]'if all is OK then start copy & paste;[/COLOR]
                [COLOR="SeaGreen"]'first change collor of FIMGR cell to yellow, copy the record[/COLOR]
                Target.Interior.ColorIndex = 36
                Target.Offset(0, -15).Resize(0, 14).Copy
                [COLOR="SeaGreen"]'read who is the FIMGR and paste to the corresponding sheet[/COLOR]
                [COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] UCase(Target.Value)
                    [COLOR="Navy"]Case[/COLOR] [S4]
                        [COLOR="Navy"]With[/COLOR] Sheets("MGR2")
                            LR = .Cells(199, 2).End(xlUp).Row
                            .Cells(LR + 1, 2).PasteSpecial (xlPasteValues)
                        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
                        MsgBox "the record was pasted into MGR2 sheet"
                    [COLOR="Navy"]Case[/COLOR] [S5]
                        [COLOR="Navy"]With[/COLOR] Sheets("MGR3")
                            LR = .Cells(199, 2).End(xlUp).Row
                            .Cells(LR + 1, 2).PasteSpecial (xlPasteValues)
                        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
                        MsgBox "the record was pasted into MGR3 sheet"
                    [COLOR="Navy"]Case[/COLOR] [S3]
                        [COLOR="Navy"]With[/COLOR] Sheets("MGR1")
                            LR = .Cells(199, 2).End(xlUp).Row
                            .Cells(LR + 1, 2).PasteSpecial (xlPasteValues)
                        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
                        MsgBox "the record was pasted into MGR1 sheet"
                    [COLOR="Navy"]Case[/COLOR] [S6]
                        [COLOR="Navy"]With[/COLOR] Sheets("MGR4")
                            LR = .Cells(199, 2).End(xlUp).Row
                            .Cells(LR + 1, 2).PasteSpecial (xlPasteValues)
                        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
                        MsgBox "the record was pasted into MGR4 sheet"
                     [COLOR="Navy"]Case[/COLOR] [COLOR="Navy"]Else[/COLOR]
                        Target.ClearContents
                        Target.Interior.ColorIndex = xlNone
                [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Select[/COLOR]
                Target.Value = UCase(Target.Value)
                
            [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Select[/COLOR]
        
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
        
getout:
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.EnableEvents = True
 
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

ξ
 
Last edited:
Upvote 0
I can't see anything in the code that might overwrite E3 etc. on the DataEntry sheet. I would begin to suspect there's some other code doing this. At this stage I would:

  1. make a chuckable copy of the file to work on
  2. unlock all cells on the DataEntry sheet
  3. lock only those such as E3 that you're having trouble with and don't want to be overwritten
  4. disable any on error statements in the code - not just in the code above
  5. disable all userInterfaceOnly statements anywhere (check especially in open_Workbook and Sheet_Activate events (do a search for userInterfaceOnly in the entire project and disable those lines))
  6. protect the DataEntry sheet
  7. Save and Close the file (this nullifies any UserInterfaceOnly setting currently in force)
  8. Re-open the file and start doing the stuff that you think caused formulae to be deleted and wait for it to throw an error.
  9. Then when you choose debug, you'll have a good idea of what lines of code might be deleting your formulae.
  10. Adjust code and try again (in case there's more code somewhere which overwrites the formulae).
When done, copy the code, chuck the file and go back to your live file and paste in the changes.
 
Upvote 0
Another way is to use the Watch Window. No need to lose the userInterfaceOnly/error traps etc.as suggested above.
Record yourself a macro while you move from another sheet to the DataEntry sheet and select E3, press F2, press Enter (or Ctrl+Shift+Enter if it is an array-entered formula) -this just reenters the formula in that cell. I don't know what your formula is but you'll get somethoing like:
Code: 
Sheets("DataEntry").Select
Range("E3").Select
ActiveCell.FormulaR1C1 = "=IF(R[9]C[14]="""",""swer"","""")"
Range("E4").Select
condense that but change the = to <>:
Code: 
Sheets("DataEntry").Range("E3").FormulaR1C1 [COLOR=Red]<>[/COLOR] "=IF(R[9]C[14]="""",""swer"","""")"
Select the whole line of code, right-click it, choose Add Watch…, leave the first field as-is, use (All Procedures) and (All modules) for the context fields, and under Watch Type, choose the Break when value is True option.
Now try using your spreadsheet as a user and wait for the code to stop. The code should stop at the line directly after the one that has changed E3. However, that line could be the first line of a sheet_change event (or any other event that's been triggered). A bit of a pain. Two things you can do:
1. continue pressing F8 until that run of the event exits and it should take you back to just after the culprit line
2. bring up the Call Stack (Ctrl+L) and you'll see at the top the macro/event that the code's currently executing. If you double-click the entry below that it will take you to the line the current procedure was called from, with a green triangle in the left margin; that should be your culprit line.
 
Last edited:
Upvote 0
xenou said:
I think the patch jobs have made your code a bit confusing. Best thing I think is a rewrite. Try this and see if it works (note that I have commented out the error handler. We want the program to crash if it errors - that's how you find out where the error is).
ξ
Click to expand...
Using this code I get a run-time when I tab out of Q11 with 'Target.Interior.ColorIndex = 36' highlighted. At this point, as an experiment, I can continue to enter data and I do not lose any formulas. But none of the rows get pasted and it's not formatting dates and cases.
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Solved
Move entire row based on expiration date
2
Replies
17
Views
292
rollis13
rollis13
S
  • Question
I have a problem in audit trail with VBA
Replies
1
Views
154
Joe4
Joe4
A
  • Question
sometimes show "Method 'Range' of object '_Worksheet' failed" error and maybe not error!!
Replies
0
Views
412
abdelfattah
A
G
  • Solved
Format & Protect range of cells using VBA
Replies
7
Views
314
Gajendran Yadhav
G
I
  • Question
Current Code taking 10 Hours to run. Need Help to Optimize
Replies
5
Views
277
ItalianPlatinum
I

Forum statistics

Threads
1,215,294
Messages
6,124,101
Members
449,142
Latest member
championbowler

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top