Link to home
Start Free TrialLog in
Avatar of agwalsh
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
Avatar of Shanan212
Shanan212
Flag of Canada image

Please see attached.

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
Avatar of agwalsh
agwalsh

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..
Protection could be the issue

Put his at the beginning of the sub

    If ActiveSheet.ProtectContents = True Then
        ActiveSheet.Unprotect "YOURPASSWORD HERE"
    End If

Open in new window



This at the end of your sub
ActiveSheet.protect "YOURPASSWORD HERE"

Open in new window

Avatar of agwalsh

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.ProtectContents = True Then
        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


End sub

Open in new window


Since the sheet is protected by you, you would know the password correct?
Avatar of agwalsh

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..
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.ProtectContents = True Then
        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
Avatar of agwalsh

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 :-)
Avatar of agwalsh

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,I9,J9,k9,G10,J10,G11,J11,K11,G14:G19,J15:J19,G20,G21,G22,j22,G23,G24:G31,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,B10:B13,B17:B20,B25:B28,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
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
Avatar of agwalsh

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.ProtectContents = 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,I9,J9,k9,G10,J10,G11,J11,K11,G14:G19,J15:J19,G20,G21,G22,j22,G23,G24:G31,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,B10:B13,B17:B20,B25:B28,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
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

Private Sub sWorkbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Open in new window

Avatar of agwalsh

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.. :-)
ASKER CERTIFIED SOLUTION
Avatar of Shanan212
Shanan212
Flag of Canada image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of agwalsh

ASKER

This solved it - thank you :-)