Solved

Code not working on protected worksheet

Posted on 2013-01-07
15
240 Views
Last Modified: 2013-01-24
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
0
Comment
Question by:agwalsh
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 8
  • 7
15 Comments
 
LVL 13

Expert Comment

by:Shanan212
ID: 38750976
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
0
 

Author Comment

by:agwalsh
ID: 38754775
@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..
0
 
LVL 13

Expert Comment

by:Shanan212
ID: 38754855
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

0
PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

 

Author Comment

by:agwalsh
ID: 38755016
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 :-)
0
 
LVL 13

Expert Comment

by:Shanan212
ID: 38755058
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?
0
 

Author Comment

by:agwalsh
ID: 38755649
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..
0
 
LVL 13

Expert Comment

by:Shanan212
ID: 38755704
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
0
 

Author Comment

by:agwalsh
ID: 38758122
@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 :-)
0
 

Author Comment

by:agwalsh
ID: 38758258
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
0
 
LVL 13

Expert Comment

by:Shanan212
ID: 38758973
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
0
 

Author Comment

by:agwalsh
ID: 38762223
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
0
 
LVL 13

Expert Comment

by:Shanan212
ID: 38763402
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

0
 

Author Comment

by:agwalsh
ID: 38781840
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.. :-)
0
 
LVL 13

Accepted Solution

by:
Shanan212 earned 500 total points
ID: 38783118
Ok I worked with many sheets like you are doing; where its mandatory to fill out fields. There are some problems.

The before close procedure: It wouldn't let you close the sheet without filling fields. This is ok. However, the problem is even I can't close it (nor can you - someone who is working on it or mistakenly opened it)

I recommend a before-save event.

Now for your question, there is a procedure called 'worksheet change' event which tracks changes in cells. You can use this to track whether user changed/not changed cell contents.

Eg: Below checks and pops up a msg if A2 or A3 has no entries

Private Sub Worksheet_Change(ByVal Target As Range)

   If Target.address = "$A$2" or target.address = "$A$3" then
            if len(target) < 0 then                                    'here checks for contents/length of target cell
            msgbox "Cell has no entry: "&target.address
            end if
   end if
End sub

Open in new window


http://www.ozgrid.com/VBA/run-macros-change.htm
0
 

Author Closing Comment

by:agwalsh
ID: 38813700
This solved it - thank you :-)
0

Featured Post

Office 365 Training for IT Pros

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Microsoft Office Picture Manager was included in Office 2003, 2007, and 2010, but not in Office 2013. Users had hopes that it would be in Office 2016/Office 365, but it is not. Fortunately, the same zero-cost technique that works to install it with …
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

710 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question