Vb Sourcing/Macros Freezing formulas after input

[Sammy1994]

Hello,

I've been trying to figure something out and currently I am required to use vb sourcing for a solution to my issue.

My issue is trying to freeze a formula which is =IF(A3="","",IF(B3="",NOW(),B3)) after someone places the input into A3.

I need it to freeze so if that user deletes what is in A3 it will not change the date and time, I'm trying to clock input times and secure it from modification. I am not very familiar with VB sourcing or macros, so please be detailed about the solution if there is one.


Thank you,

Sam

 

[Sammy1994]

I have figured out how to lock and only allow VD to input information into Column B.
However, I noticed if a user would have re-input data on column A it changes the time stamp. Which is something I'm trying to avoid. I just want the time stamp to freeze after something was being placed into A no matter what. This is what I have so far


Private Sub Worksheet_Change(ByVal Target As Range)


ActiveSheet.Unprotect Password:="123"
Worksheets("sheet1").Range("B3:B250").Locked = True
ActiveSheet.Protect Password:="123", UserInterfaceOnly:=True



Dim MyRange As Range
Dim cell As Range


' See if update in range A2:A250
Set MyRange = Intersect(Target, Range("A2:A250"))


' Exit if update not in range
If MyRange Is Nothing Then Exit Sub

' Loop through cells in range that were updated
For Each cell In MyRange
' Add timestamp to column B if value in column A
If cell <> "" Then cell.Offset(0, 1) = Now()
Next cell

End Sub

 

[Joe4]

Try something like this:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim MyRange As Range
    Dim cell As Range

'   See if update in range A3:A250
    Set MyRange = Intersect(Target, Range("A3:A250"))

    If Not (MyRange Is Nothing) Then
'       Loop through cells in range that were updated
        For Each cell In MyRange
'           Add timestamp to column B if value in column A and nothing in column B
            If cell <> "" And cell.Offset(0, 1) = "" Then
'               Update cell in column B
                cell.Offset(0, 1) = Now()
'               Protect cell in column B
                ActiveSheet.Unprotect Password:="password"
                cell.Offset(0, 1).Locked = True
                ActiveSheet.Protect Password:="password"
            End If
        Next cell
    End If

End Sub