• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Time bound cell lock

J

jigar_mehta

New Member
Dear All,

I have an excell file which contatins daily datas on regular basis.

File contains date in the first column.

I want to avoid back dated entry and hence want to lock the cells at least with a margin of two day to entry in the same and if require asks for approval password.

E.g. if current date is 16.4.13 it will not allow entry of data of date 14.4.13 and before that.

Each record has a unique serial number

with above feeture I as well would like to check that above record no is exactly one number less than current one so that any missing record entry can be avoided.

If by intention we have skip any record it will ask approval password.


PLease help in this matter.
 
Jigar_mehta


Can you upload a sample file for us to see what/where you want something done


Refer: http://chandoo.org/forums/topic/posting-a-sample-workbook
 
Hi, jigar_metha!


Try adding this code to the related worksheet section in the VBA editor (Alt-F11). You should adjust the value for constant "ksrng" to the range for which you want to perform the validation. You should too protect the VBA project so as users couldn't enter and look at the password stored in constant "ksPassword".


-----

[pre]
Code: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
' constants
Const ksrng = "A:A"
Const kiTolerance = 1 'days before today accepted
Const ksPassword = "everybodyknows"
' declarations
Dim rng As Range
Dim D As Date, A As String
' start
Set rng = Range(ksrng)
If Application.Intersect(Target, rng) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
' process
Application.EnableEvents = False
If IsDate(Target.Cells(1, 1).Value) Then
D = Target.Cells(1, 1).Value
If D < Int(Now()) - kiTolerance Then
A = InputBox("Enter password to input outdated values", "Password")
If A = ksPassword Then
MsgBox "Input accepted", vbInformation, "Confirmation"
Else
MsgBox "Input rejected", vbCritical, "Warning"
Application.Undo
End If
End If
End If
Application.EnableEvents = True
' end
End Sub
[/pre]
-----


Regards!
 
Hi Mehta ,


It is good that you have uploaded your file ; the question now is , how do we download it ? Can you let us know ?


Narayan
 
Hi, jigar_metha!


This is the updated code regarding your uploaded file. Follow the indications of my previous post.

-----

[pre]
Code: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
' constants
Const ksrngDate = "C:C"
Const ksrngData = "D:D"
Const kiTolerance = 1 'days before today accepted
Const ksPassword = "everybodyknows"
' declarations
Dim rngDate As Range, rngData As Range
Dim D As Date, A As String
' start
Set rngDate = Range(ksrngDate)
Set rngData = Range(ksrngData)
If Application.Intersect(Target, rngData) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
' process
Application.EnableEvents = False
D = rngDate.Cells(Target.Cells(1, 1).Row, 1).Value
If D < Int(Now()) - kiTolerance Then
A = InputBox("Enter password to input outdated values", "Password")
If A = ksPassword Then
MsgBox "Input accepted", vbInformation, "Confirmation"
Else
MsgBox "Input rejected", vbCritical, "Warning"
Application.Undo
End If
End If
Application.EnableEvents = True
' end
Set rngData = Nothing
Set rngDate = Nothing
End Sub
[/pre]
-----


Regards!
 
You must log in or register to reply here.
Back
Top