protect a worksheet for everybody except the VBA writer

[Valeria]

Dear Experts,
I have a workbook which contains some VBA "Worksheet_Change" code.
Basically, when a user makes a change in a certain cell, the cell next to it
changes to reflect the name of this user.
This is a security check for me, to make sure that the person who has
actually inputed the cell is also the one allowed to do so.
But the cell containing his/her name must be protected, otherwise everybody
can change it... only when I try to do so, I get an error from the
Worksheet_Change code, as it's not allowed anymore to input the name in the
protected cell.
Is there a way I can allow VBA to write in these otherwise protected cells
for everybody else?

I hope I was clear, if not please let me know and I'll rephrase my problem!

Thanks in advance for your precious and needed help!
Best regards,

 

[Frank Kabel]

Hi
in your macro use

me.unprotect password:="your_password"
'some code
me.protect password:="your_password"

 

[Valeria]

Hi Frank,
I have tried, but it still does not work! When I look at my code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vrange As Range
Dim vvrange As Range
Dim cell As Object
Set vrange = Range("ID_Conf")
Set vvrange = Range("Approval_Granted_For")
Me.Unprotect Password:="my_password"
For Each cell In Target
If Union(cell, vrange).Address = vrange.Address Then
Target.Offset(0, 1).Value = Application.UserName
Target.Offset(0, 2).Value = Format(Date, "DD-MMM-YYYY")
ElseIf Union(cell, vvrange).Address = vvrange.Address Then
Target.Offset(0, 1).Value = Month(Now - 33 + 30 * Target.Cells.Value) & "/"
& "01/" & Year(Now - 33 + 30 * Target.Cells.Value)
End If
Next cell
On Error GoTo errhandler
errhandler:
Application.EnableEvents = True
Me.Protect Password:="my_password"
End Sub

I realize that the problem is in the Target.Offset(0, 2).Value =
Format(Date, "DD-MMM-YYYY") line.
If I comment it out, everything works. What can't understand is that,
without the protection, this code works well also for the second offset, and
with the protection, this second offset will give me an "application-defined
or object-defined error".
I have locked the cells in both columns offset 1 and 2, their format is the
same.

What can be the source of error? I am out of ideas!

Many thanks in advance!

Best regards,
Valeria

 

[Dave Peterson]

I'm not quite sure what goes into those ranges, but maybe this will get you
closer:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vrange As Range
Dim vvrange As Range
Dim cell As Object
Set vrange = Range("ID_Conf")
Set vvrange = Range("Approval_Granted_For")
Me.Unprotect Password:="my_password"

Application.EnableEvents = False
On Error Resume Next
For Each cell In Target
If Union(cell, vrange).Address = vrange.Address Then
Target.Offset(0, 1).Value = Application.UserName
Target.Offset(0, 2).Value = Format(Date, "DD-MMM-YYYY")
ElseIf Union(cell, vvrange).Address = vvrange.Address Then
Target.Offset(0, 1).Value = Month(Now - 33 + 30 _
* Target.Cells.Value) & "/" _
& "01/" & Year(Now - 33 + 30 * Target.Cells.Value)
End If
Next cell
On Error goto 0
Me.Protect Password:="my_password"
End Sub

 

[Valeria]

Hi,
Well, I always get the same problem, even with this error handling...
After fighting with the spreadsheet, I found out what was causing the
problem: apparently you need to unprotect the sheet twice, once before every
offset! It works like this, but I still can't understand why:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vrange As Range
Dim vvrange As Range
Dim cell As Object
Me.Unprotect Password:="my_password"
Set vrange = Range("ID_Conf")
Set vvrange = Range("Approval_Granted_For")
For Each cell In Target
If Union(cell, vrange).Address = vrange.Address Then
Target.Offset(0, 1).Value = Application.UserName
Me.Unprotect Password:="my_password"
Target.Offset(0, 2).Value = Format(Date, "DD-MMM-YYYY")
ElseIf Union(cell, vvrange).Address = vvrange.Address Then
Target.Offset(0, 1).Value = Month(Now - 33 + 30 * Target.Cells.Value) & "/"
& "01/" & Year(Now - 33 + 30 * Target.Cells.Value)
End If
Next cell
On Error GoTo 0
Me.Protect Password:="my_password"
End Sub

Does somebody know the reason for this? I am quite curious now!
Many thanks,
best regards,
Valeria

 

[Dave Peterson]

One of the lines I had in my suggested code was this:
application.enableevents = false

You don't have that in your code.

Try putting a breakpoint on the first "me.unprotect" line.
(Just click on that line and hit F9--it'll have a red "fill" color.)

Now back to your worksheet and type something into the ID_conf range and hit
enter.

When the code gets to that breakpoint it'll stop and wait for you. Hit F8 to
continue executing your code.

Watch the path that it takes--it goes through your code multiple times. When
you change something, that causes the event to fire a second time (even if it's
the code that's doing the changing).

Add one of those "application.enableevents = false" to the top of your code
(right before the "For each cell" line) and see what happens the next time you
change something.

ps. Didn't my suggestion work? It did for me.

Hi,
Well, I always get the same problem, even with this error handling...
After fighting with the spreadsheet, I found out what was causing the
problem: apparently you need to unprotect the sheet twice, once before every
offset! It works like this, but I still can't understand why:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vrange As Range
Dim vvrange As Range
Dim cell As Object
Me.Unprotect Password:="my_password"
Set vrange = Range("ID_Conf")
Set vvrange = Range("Approval_Granted_For")
For Each cell In Target
If Union(cell, vrange).Address = vrange.Address Then
Target.Offset(0, 1).Value = Application.UserName
Me.Unprotect Password:="my_password"
Target.Offset(0, 2).Value = Format(Date, "DD-MMM-YYYY")
ElseIf Union(cell, vvrange).Address = vvrange.Address Then
Target.Offset(0, 1).Value = Month(Now - 33 + 30 * Target.Cells.Value) & "/"
& "01/" & Year(Now - 33 + 30 * Target.Cells.Value)
End If
Next cell
On Error GoTo 0
Me.Protect Password:="my_password"
End Sub

Does somebody know the reason for this? I am quite curious now!
Many thanks,
best regards,
Valeria

 

[Valeria]

Hi Dave,
I am not quite sure why it does this, but when I input your code with the
application.enableevents=false it works once, for the first cell I change,
and then it does not work anymore. I can input whatever cell in my target
range, without triggering the worksheet_Change macro...
And afterwards, I need to close down Excel to make it work again, even with
the other code that works with the 2 unprotect passwords.
Is there any reason for this?

Many thanks!
Best regards,
Valeria

 

[Dave Peterson]

One major reason. I left out an important line!

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vrange As Range
Dim vvrange As Range
Dim cell As Object
Set vrange = Range("ID_Conf")
Set vvrange = Range("Approval_Granted_For")
Me.Unprotect Password:="my_password"

Application.EnableEvents = False
On Error Resume Next
For Each cell In Target
If Union(cell, vrange).Address = vrange.Address Then
Target.Offset(0, 1).Value = Application.UserName
Target.Offset(0, 2).Value = Format(Date, "DD-MMM-YYYY")
ElseIf Union(cell, vvrange).Address = vvrange.Address Then
Target.Offset(0, 1).Value = Month(Now - 33 + 30 _
* Target.Cells.Value) & "/" _
& "01/" & Year(Now - 33 + 30 * Target.Cells.Value)
End If
Next cell
On Error goto 0
Application.enableevents = true '<-------this is the line!
Me.Protect Password:="my_password"
End Sub

Sorry.

(if you turn off the .enableevents to stop your code from calling itself, you've
got to remember to turn it back on when you're done. (Replace "You" with "I" in
that last sentence!)

Hi Dave,
I am not quite sure why it does this, but when I input your code with the
application.enableevents=false it works once, for the first cell I change,
and then it does not work anymore. I can input whatever cell in my target
range, without triggering the worksheet_Change macro...
And afterwards, I need to close down Excel to make it work again, even with
the other code that works with the 2 unprotect passwords.
Is there any reason for this?

Many thanks!
Best regards,
Valeria

<<snipped>>

 

[Valeria]

Hi Dave,
It works now!
I only have a major problem when I make this code written from another
macro: I have posted my problem but nobody has answered yet! :-(
I get the error "the object invoked has disconnected from its clients"!
The code is the following - quite long, I know, one part is this code, the
other part is 3 charts hyperlinks!)
Do you know what's going on?
Many thans in advance for your kindness!
Best regards,
Valeria


Sub Write_VBA_For_Security_ID()

Dim StartLine As Long
Workbooks(Montly_Report).Worksheets("Approvals_PM_Violations").Activate
Range("a1").Select
With ActiveWorkbook.VBProject.VBComponents("Sheet4").CodeModule
StartLine = .CreateEventProc("Change", "Worksheet") + 1
.InsertLines StartLine, _
"dim vrange as range" & Chr(13) & _
"dim vvrange as range" & Chr(13) & _
"Dim cell As Object" & Chr(13) & _
"Set vrange = Range(""ID_Conf"")" & Chr(13) & _
"Set vvrange = Range(""Approval_Granted_For"")" & Chr(13) & _
"Me.Unprotect Password:=""my_password""" & Chr(13) & _
"Application.EnableEvents = False" & Chr(13) & _
"On Error Resume Next" & Chr(13) & _
"For Each cell In Target" & Chr(13) & _
"If Union(cell, vrange).Address = vrange.Address Then" & Chr(13) & _
"Target.Offset(0, 1).Value = Application.UserName" & Chr(13) & _
"Target.Offset(0, 2).Value = Format(Date, ""DD-MMM-YYYY"")" & Chr(13) & _
"ElseIf Union(cell, vvrange).Address = vvrange.Address Then" & Chr(13) & _
"Target.Offset(0, 1).Value = Month(Now -33 + 30 * Target.Cells.Value) &
""/"" & ""01/"" & Year(Now -33 + 30 * Target.Cells.Value)" & Chr(13) & _
"End If" & Chr(13) & _
"Next cell" & Chr(13) & _
"On Error GoTo 0" & Chr(13) & _
"Application.enableevents = true" & Chr(13) & _
"Me.Protect Password:=""my_password"""
End With

End Sub


Sub Write_VBA_For_Charts()

Dim StartLine As Long
Workbooks(Montly_Report).Activate

With ActiveWorkbook.VBProject.VBComponents("Sheet10").CodeModule
StartLine = .CreateEventProc("BeforeRightClick", "Worksheet") + 1
.InsertLines StartLine, _
"Application.EnableEvents = False" & Chr(13) & _
"If Not Intersect(Target, Range(""d12:f12"")) Is Nothing Then" &
Chr(13) & _
" Cancel = True" & Chr(13) & _
"End If" & Chr(13) & _
"If Not Intersect(Target, Range(""d15:f15"")) Is Nothing Then" &
Chr(13) & _
" Cancel = True" & Chr(13) & _
"End If" & Chr(13) & _
"If Not Intersect(Target, Range(""d20:e20"")) Is Nothing Then" &
Chr(13) & _
" Cancel = True" & Chr(13) & _
"Application.enableevents = true" & Chr(13) & _
"End If" & Chr(13)

End With


With ActiveWorkbook.VBProject.VBComponents("Sheet10").CodeModule
StartLine = .CreateEventProc("SelectionChange", "Worksheet") + 1
.InsertLines StartLine, _
"Application.enableevents = false" & Chr(13) & _
"If Not Intersect(Target, Range(""d12:f12"")) Is Nothing Then" &
Chr(13) & _
" On Error Resume Next" & Chr(13) & _
" Charts(""Chart1_Average PM Violation"").Activate" & Chr(13) & _
" If Err.Number <> 0 Then" & Chr(13) & _
" MsgBox ""No such chart exists."", vbCritical, ""Chart Not Found""
" & Chr(13) & _
"End If" & Chr(13) & _
"On Error GoTo 0" & Chr(13) & _
"End If" & Chr(13) & _
"If Not Intersect(Target, Range(""d15:f15"")) Is Nothing Then" &
Chr(13) & _
" On Error Resume Next" & Chr(13) & _
" Charts(""Chart2_Volume Split by PM Range"").Activate" & Chr(13) & _
"On Error GoTo 0" & Chr(13) & _
"End If" & Chr(13) & _
"If Not Intersect(Target, Range(""d20:e20"")) Is Nothing Then" &
Chr(13) & _
" On Error Resume Next" & Chr(13) & _
" Charts(""Chart3_Top 10 Violators"").Activate" & Chr(13) & _
" If Err.Number <> 0 Then" & Chr(13) & _
" MsgBox ""No such chart exists."", vbCritical, ""Chart Not Found""
" & Chr(13) & _
"End If" & Chr(13) & _
"On Error GoTo 0" & Chr(13) & _
"Application.enableevents = true" & Chr(13) & _
"End If"
End With

Worksheets("Instructions").Activate
End Sub

 

[Dave Peterson]

The only time I've seen a message like that is when I closed a the wrong
workbook in a macro and later refered to it like it was still open. But that
doesn't look like the case in your code.

Just silly guesses that might be a waste of your time.

Try running Rob Bovey's code cleaner against your workbook--it exports, deletes
modules and reimports your code. (you can also do it manually)

You can find it here.
http://www.appspro.com/

Sometimes hard to reproduce problems will be cleaned up.

Your code did work for me (after a couple of reformatting fixes -- because of
the line wrap in the newsgroup).

If you set up another test workbook with just enough data to make it useful and
copy over the macros, will it work?

(I don't have another guess.)

You could search google. Maybe there'll be someone who had similar problems and
got a solution that will work for you, too.

 

[Valeria]

Hi Dave,
thank you! My error is so odd, I ran the code fixer and it worked once...
but just once! I was then having the same problem again.
I think I understood what disturbs Excel: if I run the first VBA-writer code
alone it works, the second alone works... what Excel does is that it goes
from the original workobook, where the code is, to the VBA of the target
workbook to write on it. At the end, it does not know anymore where it is, so
if I ask it to come back to my original code, it can't find it anymore,
that's why I get the message.
If I put the one VBA writer code at the end of my procedure, with no more
referring to other code, it works. And what I am doing now, after the macro
has finished working, I manually launch the second macro, which means I am
manually going back to the code of the original workbook.

It is quite complex to explain, I hope you understand what I mean!

A last question: do you know a way to force Excel to come back to the
original code it's executing?

Many thanks, I hope my experience was at least somehow useful!

Best regards,
Valeria

 

[Dave Peterson]

I added some message boxes at the end of your procedures.

When I tested your code, it worked fine--I saw the message boxes from both
procedures. So I can't even duplicate your problem.

I don't know what to suggest. Maybe someone else can see a problem????

Hi Dave,
thank you! My error is so odd, I ran the code fixer and it worked once...
but just once! I was then having the same problem again.
I think I understood what disturbs Excel: if I run the first VBA-writer code
alone it works, the second alone works... what Excel does is that it goes
from the original workobook, where the code is, to the VBA of the target
workbook to write on it. At the end, it does not know anymore where it is, so
if I ask it to come back to my original code, it can't find it anymore,
that's why I get the message.
If I put the one VBA writer code at the end of my procedure, with no more
referring to other code, it works. And what I am doing now, after the macro
has finished working, I manually launch the second macro, which means I am
manually going back to the code of the original workbook.

It is quite complex to explain, I hope you understand what I mean!

A last question: do you know a way to force Excel to come back to the
original code it's executing?

Many thanks, I hope my experience was at least somehow useful!

Best regards,
Valeria