• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 260
  • Last Modified:

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
0
agwalsh
Asked:
agwalsh
  • 8
  • 7
1 Solution
 
Shanan212Commented:
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
 
agwalshAuthor Commented:
@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
 
Shanan212Commented:
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
Cloud Class® Course: Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

 
agwalshAuthor Commented:
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
 
Shanan212Commented:
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
 
agwalshAuthor Commented:
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
 
Shanan212Commented:
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
 
agwalshAuthor Commented:
@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
 
agwalshAuthor Commented:
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
 
Shanan212Commented:
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
 
agwalshAuthor Commented:
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
 
Shanan212Commented:
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
 
agwalshAuthor Commented:
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
 
Shanan212Commented:
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
 
agwalshAuthor Commented:
This solved it - thank you :-)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: CompTIA Healthcare IT Tech

This course will help prep you to earn the CompTIA Healthcare IT Technician certification showing that you have the knowledge and skills needed to succeed in installing, managing, and troubleshooting IT systems in medical and clinical settings.

  • 8
  • 7
Tackle projects and never again get stuck behind a technical roadblock.
Join Now