Protect cells based on Date and previously entered data

[Greg H.]

I am working on an ambitious project for my team to create a vacation
calendar. I need to be able to lock specific cells based on different
criteria. Below is a sample of what the sheet will look like:
A B C D E F
G
1 Name Reason Start Stop Total Time Notes
2 4/1/2008 Greg Appointment 10:00 12:00 2:00
3 4/2/2008
4 4/3/2008

Here are my criteria:
1) If the date in A2 is <= Today then protect A2:G2. Repeat for each day of
the month until date in column A is > Today, if date in column A is > Today
then unprotect that row of cells.
2) Once a name has been entered into column B and is set for a future date
that no one but that person whose name is on there can remove it. I have a
list of team members and a Windows login name (Greg = jonesgr, Bob = smithbo)
For example, assume today = 3/01/08. In cell B2 only someone with USERID of
jonesgr can modify that row. If Bob opens the excel document cells B2:G2
should be locked.
3) Final requirement is that me, the supervisor have complete, unrestricted
access to the entire document. So if my USERID accesses the document,
everything is unlocked.

I do not intend to have this workbook setup as a shared document because I
don’t want people trying to save their vacation on the same day and create
scheduling problems. I know I can hack some bad code together that will work
most of the time but I know that there is an easier way to do it. Any
assistance I can get would be greatly appreciated. Thanks

 

[mikedbman]

I am working on an ambitious project for my team to create a vacation
calendar. I need to be able to lock specific cells based on different
criteria. Below is a sample of what the sheet will look like:
A B C D E F
G
1 Name Reason Start Stop Total Time Notes
2 4/1/2008 Greg Appointment 10:00 12:00 2:00
3 4/2/2008
4 4/3/2008

Here are my criteria:
1) If the date in A2 is <= Today then protect A2:G2. Repeat for each day of
the month until date in column A is > Today, if date in column A is > Today
then unprotect that row of cells.
2) Once a name has been entered into column B and is set for a future date
that no one but that person whose name is on there can remove it. I have a
list of team members and a Windows login name (Greg = jonesgr, Bob = smithbo)
For example, assume today = 3/01/08. In cell B2 only someone with USERID of
jonesgr can modify that row. If Bob opens the excel document cells B2:G2
should be locked.
3) Final requirement is that me, the supervisor have complete, unrestricted
access to the entire document. So if my USERID accesses the document,
everything is unlocked.

I do not intend to have this workbook setup as a shared document because I
don’t want people trying to save their vacation on the same day and create
scheduling problems. I know I can hack some bad code together that will work
most of the time but I know that there is an easier way to do it. Any
assistance I can get would be greatly appreciated. Thanks

 

[mikedbman]

Here is how I'd do it:
In VB editor, go to the "ThisWorkbook" Object and place this code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets("sheet1").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True, Password:=mike

End Sub

Private Sub Workbook_Open()
Sheets("sheet1").Select
ActiveSheet.Unprotect Password:=mike
Cells(1, 1).Select

End Sub

Next in the sheet1 Object place this code:
Option Explicit
Option Base 1
Public TheUser As String
Public TheRow As Double
Public TheCol As Double
Public TheData As Variant

Private Sub Worksheet_Activate()
ActiveSheet.Unprotect , Password:=mike
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WhoIsIt As String
Dim TheDataWas As Variant
Dim MasterID As String
Dim X As Double
Dim Y As Double
Dim Usrid As String

Let MasterID = "YourID" 'Note, change "YourID" to the id that is your id,
the master id!

If TheData = "Stop" Then
Let TheData = ActiveCell.Value
Let TheRow = ActiveCell.Row
Let TheCol = ActiveCell.Column
Exit Sub
End If
Let Usrid = fOSUserName
If Len(TheUser) > 0 Then
If (Cells(TheRow, 2).Value = "Greg" And LCase(Usrid) = "jonesgr") Or
Usrid = MasterID Then
ElseIf (Cells(TheRow, 2).Value = "Bob" And LCase(Usrid) = "smithbo") Or
Usrid = MasterID Then
ElseIf (Cells(TheRow, 2).Value = "Mike" And LCase(Usrid) = "mhirsch") Or
Usrid = MasterID Then
Else
Let TheDataWas = TheData
Let TheData = "Stop"
Cells(TheRow, TheCol).Value = TheDataWas
End If
Else
If Cells(TheRow, 2).Value <> Usrid And Usrid <> MasterID Then 'this
prevents someone from enter someone else's records
Let TheDataWas = MsgBox(Prompt:="You may NOT enter a record for
someone else!", Title:="Not Allowed!", Buttons:=vbCritical)
Let TheData = "Stop"
Cells(TheRow, 2) = Empty
End If
End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Let TheData = ActiveCell.Value
Let TheRow = ActiveCell.Row
Let TheCol = ActiveCell.Column
Let TheUser = Cells(TheRow, 2).Value
End Sub

Lastly, insert a module and place this code in the module:
(If you don't know how to add a module, I think you could also put this on
the Sheet1 object. Good luck!

'******************** Code Start **************************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
Private Declare Function APIGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = APIGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function
'******************** Code End **************************