Solved

Code not working on protected worksheet

Posted on 2013-01-07
15
235 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
  • 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
 

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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

In case Office 2010 has not been deployed in your environment, this article may be quite useful. In our office, we wanted a way to deploy Microsoft Office Professional Plus 2010 through an automated batch file via logon script. This article is docum…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

759 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now