I would like to create an approval column in a spreadsheet that contains holiday applications. My initial idea is to have a locked column with password protected. However, it has more than one person to approve for different sections. Any idea to accomplish this requirement? Thanks!
You can have a Userform pop up with list of signatorys. When a peson double ckick his name it prompt for his password. If the password is correct the approved column is automatically filled.
I open the file and see your design - perfect but I may not need Admin approval and just supervisor approval and disapproval - the application on one line only. However I could not see the operation - no password! I have no idea how to copy it into my spreadsheet and necessary configuration. Can you give me the instructions to follow.
here i modified it so only
supervisor range you supply.
there is instruction in the code
and i think it is very straight forward.
you only need to substitute the values
of the CONSTANT (CONST).
go to VBA (alt-F11).
on the Left pane, double-click on ThisWorkbook.
insert the code there.
you also need to make the code
safe so no one can see your code.
on VBA go to Tools on the menu.
then VBAProject Properties...
Protection tab, tick Lock project from viewing.
set the password.
Code:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Const SUPERVISOR_RANGE As String = "E1:H6"
Const ACTIVE_SHEET As String = "Sheet1"
Const PASSWORD As String = "arnel"
Const RANGE_TO_KICK_USER As String = "D1"
' SUPERVISOR_RANGE = the rectangular area where
' approval/disapproval is located. include
' the range where there is a checkbox.
' ACTIVE_SHEET = the sheet where the application for leave
' is located (my sample SHEET1)
' PASSWORD = the static password needed so
' user can "enter" the SUPERVISOR_RANGE
' RANGE_TO_KICK_USER when password is invalid you
' don't want the user to enter
' that range, instead put him
' on another range.
Static bolInSupervisor As Boolean
Dim rng1 As Range
Dim bolCellInSupervisor As Boolean
Dim strPass As String
On Error Resume Next
If ActiveSheet.Name = ACTIVE_SHEET Then
bolCellInSupervisor = False
Set rng1 = Intersect(Range(SUPERVISOR_RANGE), Target)
bolCellInSupervisor = (Not rng1 Is Nothing)
Err.Clear
If bolCellInSupervisor = True Then
If Not bolInSupervisor Then
strPass = InputBox("Please enter Supervisor password", "Password Required") & ""
bolInSupervisor = (strPass = PASSWORD)
If Not bolInSupervisor Then
Range(RANGE_TO_KICK_USER).Select
End If
End If
End If
End If
End Sub