agwalsh
asked on
Code not working on protected worksheet
hi Folks
I have a file with dropdown cells set up (the data sheet it links to has been removed) and data can only be entered into the white cells. Thanks to you kind people I got code
http://www.vbaexpress.com/kb/getarticle.php?kb_id=587
that will fire when someone tries to close the workbook without certain specified cells being completed. I did get this working but now for some reason it's not working - maybe because the workbook is now protected. I'm attaching the file.. thanks as always.. the password is password
invoice---code-not-changing-the-.xlsm
I have a file with dropdown cells set up (the data sheet it links to has been removed) and data can only be entered into the white cells. Thanks to you kind people I got code
http://www.vbaexpress.com/kb/getarticle.php?kb_id=587
that will fire when someone tries to close the workbook without certain specified cells being completed. I did get this working but now for some reason it's not working - maybe because the workbook is now protected. I'm attaching the file.. thanks as always.. the password is password
invoice---code-not-changing-the-.xlsm
ASKER
@shanan212 - will take that on board about using the before save function and have adjusted accordingly
I have transferred this code across but when I try to save the file (without all the cells being completed) it stops at the following point..
Cell.Interior.ColorIndex = 0 '** no color. I have now protected the sheet..thanks for your help..
I have transferred this code across but when I try to save the file (without all the cells being completed) it stops at the following point..
Cell.Interior.ColorIndex = 0 '** no color. I have now protected the sheet..thanks for your help..
Protection could be the issue
Put his at the beginning of the sub
This at the end of your sub
Put his at the beginning of the sub
If ActiveSheet.ProtectContents = True Then
ActiveSheet.Unprotect "YOURPASSWORD HERE"
End If
This at the end of your sub
ActiveSheet.protect "YOURPASSWORD HERE"
ASKER
The only thing about this is that the user wants it set up so that the ONLY cells their users have access to are the unprotected ones...and (maybe I'm wrong) but it seems to me that the amendment you are proposing requires the user to know the password...
Also when you say "at the beginning of the sub" is that in the following syntax?
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If ActiveSheet.ProtectContent s = True Then
ActiveSheet.Unprotect "YOURPASSWORD HERE"
And then where should the last bit go? i.e. ActiveSheet.protect "YOURPASSWORD HERE" as always thank you :-)
Also when you say "at the beginning of the sub" is that in the following syntax?
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If ActiveSheet.ProtectContent
ActiveSheet.Unprotect "YOURPASSWORD HERE"
And then where should the last bit go? i.e. ActiveSheet.protect "YOURPASSWORD HERE" as always thank you :-)
Ya you got the beginning correct
End part should go before this piece of code
Since the sheet is protected by you, you would know the password correct?
End part should go before this piece of code
End sub
Since the sheet is protected by you, you would know the password correct?
ASKER
I would yes, but this is for someone else and she definitely doesn't want her group of users to know the password - what she wants is for them ONLY to be able to pick stuff from dropdown lists (not on this EE version), she wants that sheet hidden and she doesn't want them to be able to save/close the worksheet unless all the fields are completed... :-)
thank you..
thank you..
Unless the user goes into VBA Editor, they cannot see the password.
If she wants, she can password protect the code (after putting a different password to protect the sheet)
You can teach her to password protect the code/do it on behalf of her using her preferred password.
So for example, when protecting sheet, you use password of '123456'
If ActiveSheet.ProtectContent s = True Then
ActiveSheet.Unprotect "123456"
End If
Then when locking the VBA code, you can use 'password123'
http://msdn.microsoft.com/en-us/library/office/aa165442(v=office.10).aspx
If she wants, she can password protect the code (after putting a different password to protect the sheet)
You can teach her to password protect the code/do it on behalf of her using her preferred password.
So for example, when protecting sheet, you use password of '123456'
If ActiveSheet.ProtectContent
ActiveSheet.Unprotect "123456"
End If
Then when locking the VBA code, you can use 'password123'
To lock a VBA project for viewing
1. Open the document, template, or database that contains the VBA project you want to protect. For Outlook or FrontPage, start Outlook or FrontPage on the computer that contains the VBA project you want to protect.
2. Open the Visual Basic Editor.
3. In the Project Explorer, right-click the project you want to protect, and then click ProjectName Properties on the shortcut menu.
4. On the Protection tab, select the Lock project for viewing check box, enter and confirm the password, and then click OK.
http://msdn.microsoft.com/en-us/library/office/aa165442(v=office.10).aspx
ASKER
@shanan212 - so when this is given to the final user do they have to use a password? (she wants this to be as simple as possible and I'm pretty sure she doesn't want them to have a password........
and why does it stop at
Cell.Interior.ColorIndex = 6 '** color yellow
when it gets to this bit of code?
For Each Cell In Rng1
If Cell.Value = vbNullString Then
Cell.Interior.ColorIndex = 6 '** color yellow
If Start Then RngStr = RngStr & Cell.Parent.Name & vbCrLf
Start = False
RngStr = RngStr & Cell.Address(False, False) & ", "
Else
Cell.Interior.ColorIndex = 0 '** no color
End If
As always...thank you :-)
and why does it stop at
Cell.Interior.ColorIndex = 6 '** color yellow
when it gets to this bit of code?
For Each Cell In Rng1
If Cell.Value = vbNullString Then
Cell.Interior.ColorIndex = 6 '** color yellow
If Start Then RngStr = RngStr & Cell.Parent.Name & vbCrLf
Start = False
RngStr = RngStr & Cell.Address(False, False) & ", "
Else
Cell.Interior.ColorIndex = 0 '** no color
End If
As always...thank you :-)
ASKER
Been messing around with it a bit more and I've got it working better - however what do I need to do with the code below so that if and when the person makes the required amendments... the yellow fill disappears (at the moment when the form is completed after being reminded - it still stays yellow...)
As always...thank you..
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Start As Boolean
Dim Rng1 As Range
'Rng3 As Range, 'Rng4 As Range
Dim Prompt As String, RngStr As String
Dim Cell As Range
'set your ranges here
'Rng1 is on sheet "Group Profile" and cells B5 through B14
'Cell F1, A range of F5 through F7 etc. you can change these to
'suit your needs.
Set Rng1 = Sheets("Invoice Requisition Perm").Range("G9,g11,g13,I 9,J9,k9,G1 0,J10,G11, J11,K11,G1 4:G19,J15: J19,G20,G2 1,G22,j22, G23,G24:G3 1,J24:J32" )
'Set Rng3 = Sheets("Eligibility Guidelines").Range("F1,E5, E6,E9,E10, B7:B17,B21 :B36")
'Set Rng4 = Sheets("COBRA").Range("J2, H4,H5,J15, B4,B5,B9,B 10:B13,B17 :B20,B25:B 28,E17: E20")
'message is returned if there are blank cells
Prompt = "Please check your data ensuring all required " & _
"cells are complete." & vbCrLf & "you will not be able " & _
"to close or save the workbook until the form has been filled " & _
"out completely. " & vbCrLf & vbCrLf & _
"The following cells are incomplete and have been highlighted yellow:" _
& vbCrLf & vbCrLf
Start = True
'highlights the blank cells
For Each Cell In Rng1
If Cell.Value = vbNullString Then
Cell.Interior.ColorIndex = 6 '** color yellow
If Start Then RngStr = RngStr & Cell.Parent.Name & vbCrLf
Start = False
RngStr = RngStr & Cell.Address(False, False) & ", "
Else
Cell.Interior.ColorIndex = 0 '** no color
End If
Next
If RngStr <> "" Then RngStr = Left(RngStr, Len(RngStr) - 2)
Start = True
If RngStr <> "" Then RngStr = RngStr & vbCrLf & vbCrLf
'For Each Cell In Rng3
'If Cell.Value = vbNullString Then
' Cell.Interior.ColorIndex = 6 '** color yellow
'If Start Then RngStr = RngStr & Cell.Parent.Name & vbCrLf
'Start = False
'RngStr = RngStr & Cell.Address(False, False) & ", "
'Else
'Cell.Interior.ColorIndex = 0 '** no color
'End If
'Next
'If RngStr <> "" Then RngStr = Left$(RngStr, Len(RngStr) - 2)
'Start = True
'If RngStr <> "" Then RngStr = RngStr & vbCrLf & vbCrLf
'For Each Cell In Rng4
'If Cell.Value = vbNullString Then
'Cell.Interior.ColorIndex = 6 '** color yellow
'If Start Then RngStr = RngStr & Cell.Parent.Name & vbCrLf
'Start = False
'RngStr = RngStr & Cell.Address(False, False) & ", "
'Else
'Cell.Interior.ColorIndex = 0 '** no color
'End If
'Next
If RngStr <> "" Then RngStr = Left$(RngStr, Len(RngStr) - 2)
If RngStr <> "" Then
MsgBox Prompt & RngStr, vbCritical, "Incomplete Data"
Cancel = True
Else
'saves the changes before closing
ThisWorkbook.Save
Cancel = False
End If
Set Rng1 = Nothing
End Sub
As always...thank you..
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Start As Boolean
Dim Rng1 As Range
'Rng3 As Range, 'Rng4 As Range
Dim Prompt As String, RngStr As String
Dim Cell As Range
'set your ranges here
'Rng1 is on sheet "Group Profile" and cells B5 through B14
'Cell F1, A range of F5 through F7 etc. you can change these to
'suit your needs.
Set Rng1 = Sheets("Invoice Requisition Perm").Range("G9,g11,g13,I
'Set Rng3 = Sheets("Eligibility Guidelines").Range("F1,E5,
'Set Rng4 = Sheets("COBRA").Range("J2,
'message is returned if there are blank cells
Prompt = "Please check your data ensuring all required " & _
"cells are complete." & vbCrLf & "you will not be able " & _
"to close or save the workbook until the form has been filled " & _
"out completely. " & vbCrLf & vbCrLf & _
"The following cells are incomplete and have been highlighted yellow:" _
& vbCrLf & vbCrLf
Start = True
'highlights the blank cells
For Each Cell In Rng1
If Cell.Value = vbNullString Then
Cell.Interior.ColorIndex = 6 '** color yellow
If Start Then RngStr = RngStr & Cell.Parent.Name & vbCrLf
Start = False
RngStr = RngStr & Cell.Address(False, False) & ", "
Else
Cell.Interior.ColorIndex = 0 '** no color
End If
Next
If RngStr <> "" Then RngStr = Left(RngStr, Len(RngStr) - 2)
Start = True
If RngStr <> "" Then RngStr = RngStr & vbCrLf & vbCrLf
'For Each Cell In Rng3
'If Cell.Value = vbNullString Then
' Cell.Interior.ColorIndex = 6 '** color yellow
'If Start Then RngStr = RngStr & Cell.Parent.Name & vbCrLf
'Start = False
'RngStr = RngStr & Cell.Address(False, False) & ", "
'Else
'Cell.Interior.ColorIndex = 0 '** no color
'End If
'Next
'If RngStr <> "" Then RngStr = Left$(RngStr, Len(RngStr) - 2)
'Start = True
'If RngStr <> "" Then RngStr = RngStr & vbCrLf & vbCrLf
'For Each Cell In Rng4
'If Cell.Value = vbNullString Then
'Cell.Interior.ColorIndex = 6 '** color yellow
'If Start Then RngStr = RngStr & Cell.Parent.Name & vbCrLf
'Start = False
'RngStr = RngStr & Cell.Address(False, False) & ", "
'Else
'Cell.Interior.ColorIndex = 0 '** no color
'End If
'Next
If RngStr <> "" Then RngStr = Left$(RngStr, Len(RngStr) - 2)
If RngStr <> "" Then
MsgBox Prompt & RngStr, vbCritical, "Incomplete Data"
Cancel = True
Else
'saves the changes before closing
ThisWorkbook.Save
Cancel = False
End If
Set Rng1 = Nothing
End Sub
Remove the "s" in front of workbook in VBA to make the code work
Private Sub sWorkbook
1)
Since the user wants the sheet to be protected, I've inserted that code.
The end user dont have to know the password as the cells they need to fill are unprotected (rest are protected so that they don't get to play with titles)
The password just in case you need to unprotect the sheet is '12345'
2)
To make blank cells yellow, I've used conditional formatting.
Unprotect the sheet
Click cell G15 and then click on conditional formatting (Home tab)
Click on Manage Rules
Then on Edit Rules
see the formula (and get the idea)
then do the same for every cell.
Let me know
invoice---code-not-changing-the-.xlsm
Private Sub sWorkbook
1)
Since the user wants the sheet to be protected, I've inserted that code.
The end user dont have to know the password as the cells they need to fill are unprotected (rest are protected so that they don't get to play with titles)
The password just in case you need to unprotect the sheet is '12345'
2)
To make blank cells yellow, I've used conditional formatting.
Unprotect the sheet
Click cell G15 and then click on conditional formatting (Home tab)
Click on Manage Rules
Then on Edit Rules
see the formula (and get the idea)
then do the same for every cell.
Let me know
invoice---code-not-changing-the-.xlsm
ASKER
Thanks for that...just wondering - since it's in the code - what needs to change in the code so that the cells do go yellow when not completed. The code is now flagging what cells need to be completed but it's not changing them to yellow (I know I can set it up with conditional formatting but why isn't the code changing the blank ones to yellow...I suspect it's something simple... :-) thanks as always..
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If ActiveSheet.ProtectContent s = True Then
ActiveSheet.Unprotect "12345"
End If
Dim Start As Boolean
Dim Rng1 As Range
'Rng3 As Range, 'Rng4 As Range
Dim Prompt As String, RngStr As String
Dim Cell As Range
'set your ranges here
'Rng1 is on sheet "Group Profile" and cells B5 through B14
'Cell F1, A range of F5 through F7 etc. you can change these to
'suit your needs.
Set Rng1 = Sheets("Invoice Requisition Perm").Range("G9,g11,g13,I 9,J9,k9,G1 0,J10,G11, J11,K11,G1 4:G19,J15: J19,G20,G2 1,G22,j22, G23,G24:G3 1,J24:J32" )
'Set Rng3 = Sheets("Eligibility Guidelines").Range("F1,E5, E6,E9,E10, B7:B17,B21 :B36")
'Set Rng4 = Sheets("COBRA").Range("J2, H4,H5,J15, B4,B5,B9,B 10:B13,B17 :B20,B25:B 28,E17: E20")
'message is returned if there are blank cells
Prompt = "Please check your data ensuring all required " & _
"cells are complete." & vbCrLf & "you will not be able " & _
"to close or save the workbook until the form has been filled " & _
"out completely. " & vbCrLf & vbCrLf & _
"The following cells are incomplete and have been highlighted yellow:" _
& vbCrLf & vbCrLf
Start = True
'highlights the blank cells
For Each Cell In Rng1
If Cell.Value = vbNullString Then
Cell.Interior.ColorIndex = 6 '** color yellow
If Start Then RngStr = RngStr & Cell.Parent.Name & vbCrLf
Start = False
RngStr = RngStr & Cell.Address(False, False) & ", "
Else
Cell.Interior.ColorIndex = 0 '** no color
End If
Next
If RngStr <> "" Then RngStr = Left(RngStr, Len(RngStr) - 2)
Start = True
If RngStr <> "" Then RngStr = RngStr & vbCrLf & vbCrLf
'For Each Cell In Rng3
'If Cell.Value = vbNullString Then
' Cell.Interior.ColorIndex = 6 '** color yellow
'If Start Then RngStr = RngStr & Cell.Parent.Name & vbCrLf
'Start = False
'RngStr = RngStr & Cell.Address(False, False) & ", "
'Else
'Cell.Interior.ColorIndex = 0 '** no color
'End If
'Next
'If RngStr <> "" Then RngStr = Left$(RngStr, Len(RngStr) - 2)
'Start = True
'If RngStr <> "" Then RngStr = RngStr & vbCrLf & vbCrLf
'For Each Cell In Rng4
'If Cell.Value = vbNullString Then
'Cell.Interior.ColorIndex = 6 '** color yellow
'If Start Then RngStr = RngStr & Cell.Parent.Name & vbCrLf
'Start = False
'RngStr = RngStr & Cell.Address(False, False) & ", "
'Else
'Cell.Interior.ColorIndex = 0 '** no color
'End If
'Next
If RngStr <> "" Then RngStr = Left$(RngStr, Len(RngStr) - 2)
If RngStr <> "" Then
MsgBox Prompt & RngStr, vbCritical, "Incomplete Data"
Cancel = True
Exit Sub
ActiveSheet.Protect "12345"
Else
'saves the changes before closing
ThisWorkbook.Save
Cancel = False
ActiveSheet.Protect "buttons"
End If
Set Rng1 = Nothing
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If ActiveSheet.ProtectContent
ActiveSheet.Unprotect "12345"
End If
Dim Start As Boolean
Dim Rng1 As Range
'Rng3 As Range, 'Rng4 As Range
Dim Prompt As String, RngStr As String
Dim Cell As Range
'set your ranges here
'Rng1 is on sheet "Group Profile" and cells B5 through B14
'Cell F1, A range of F5 through F7 etc. you can change these to
'suit your needs.
Set Rng1 = Sheets("Invoice Requisition Perm").Range("G9,g11,g13,I
'Set Rng3 = Sheets("Eligibility Guidelines").Range("F1,E5,
'Set Rng4 = Sheets("COBRA").Range("J2,
'message is returned if there are blank cells
Prompt = "Please check your data ensuring all required " & _
"cells are complete." & vbCrLf & "you will not be able " & _
"to close or save the workbook until the form has been filled " & _
"out completely. " & vbCrLf & vbCrLf & _
"The following cells are incomplete and have been highlighted yellow:" _
& vbCrLf & vbCrLf
Start = True
'highlights the blank cells
For Each Cell In Rng1
If Cell.Value = vbNullString Then
Cell.Interior.ColorIndex = 6 '** color yellow
If Start Then RngStr = RngStr & Cell.Parent.Name & vbCrLf
Start = False
RngStr = RngStr & Cell.Address(False, False) & ", "
Else
Cell.Interior.ColorIndex = 0 '** no color
End If
Next
If RngStr <> "" Then RngStr = Left(RngStr, Len(RngStr) - 2)
Start = True
If RngStr <> "" Then RngStr = RngStr & vbCrLf & vbCrLf
'For Each Cell In Rng3
'If Cell.Value = vbNullString Then
' Cell.Interior.ColorIndex = 6 '** color yellow
'If Start Then RngStr = RngStr & Cell.Parent.Name & vbCrLf
'Start = False
'RngStr = RngStr & Cell.Address(False, False) & ", "
'Else
'Cell.Interior.ColorIndex = 0 '** no color
'End If
'Next
'If RngStr <> "" Then RngStr = Left$(RngStr, Len(RngStr) - 2)
'Start = True
'If RngStr <> "" Then RngStr = RngStr & vbCrLf & vbCrLf
'For Each Cell In Rng4
'If Cell.Value = vbNullString Then
'Cell.Interior.ColorIndex = 6 '** color yellow
'If Start Then RngStr = RngStr & Cell.Parent.Name & vbCrLf
'Start = False
'RngStr = RngStr & Cell.Address(False, False) & ", "
'Else
'Cell.Interior.ColorIndex = 0 '** no color
'End If
'Next
If RngStr <> "" Then RngStr = Left$(RngStr, Len(RngStr) - 2)
If RngStr <> "" Then
MsgBox Prompt & RngStr, vbCritical, "Incomplete Data"
Cancel = True
Exit Sub
ActiveSheet.Protect "12345"
Else
'saves the changes before closing
ThisWorkbook.Save
Cancel = False
ActiveSheet.Protect "buttons"
End If
Set Rng1 = Nothing
End Sub
Are you sure? The last book I attached is working for me.
The way I tested is that I changed their background colors to white. Then tried to save the file and it worked!
Dont forget to remove the "s" in front of workbook in VBA to make the code work
The way I tested is that I changed their background colors to white. Then tried to save the file and it worked!
Dont forget to remove the "s" in front of workbook in VBA to make the code work
Private Sub sWorkbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ASKER
Oh dear, the saga continues :-)
What the user wants now is text in some of the boxes e.g. input data here so the issue becomes now - how do I set the code so that it's fired when the user HAS NOT CHANGED the specific cells...the user definitely wants it so that if a user has NOT made an entry in the specified cells the code fires...thanks as always.. :-)
What the user wants now is text in some of the boxes e.g. input data here so the issue becomes now - how do I set the code so that it's fired when the user HAS NOT CHANGED the specific cells...the user definitely wants it so that if a user has NOT made an entry in the specified cells the code fires...thanks as always.. :-)
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
This solved it - thank you :-)
I recommend before-save function istead of close as it wouldn't let you close the file no matter what.
If you find any errors, go to your VBA Editor window
Select the 'Tools' Menu and select 'References'
Uncheck the 'Missing' ones
invoice---code-not-changing-the-.xlsm