Private Sub Workboook_Open()
'Auto Dating Test (1)'
  If Range("i4").Value = "CR" Then
     Range("I5").Value = Date
  End If
 Range("I5").Value = Date
End Sub

So I'm trying to get it to work with any variable/information in i4 aswell Delete the date if the value has been deleted, and not automatically update. so it only pulls the date from when the information was entered on i4. so if going back to the document days later it doesn't update automatically to the day the document was opened again. I can't get the thing to run automatically aswell as I haven't even figured out where to begin to delete the date in i5 say if the information in i4 is deleted. nor just a universal detection if somethings in i4 and not just a specific string.

CodePudding user response：

did you mean like if A4 gets deleted so does A5 and if A4 gets edited the date is shown in A5? try below

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("A4")) Is Nothing Then
If Target.Value = "" Then
    Range("A5") = "" 'if A4 gets deleted same goes for A5
Else
    Range("A5") = Date 'if A4 gets edited with any value show the date in A5
End If
End If
End Sub

CodePudding user response：

A 'True' Worksheet Change Backed Up By a Workbook Open

• These codes have to be copied into three different modules. Additionally, the sheet code name (Sheet1) in PopulateVariables has to be adjusted.

ThisWorkbook

Option Explicit

Private Sub Workboook_Open()
    PopulateVariables
End Sub

Sheet Module e.g. Sheet1

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    DateChange Target
End Sub

Standard Module e.g. Module1

Option Explicit

Private Const CHANGE_CELL As String = "I4"
Private Const DATE_CELL As String = "I5"
Private ChangeCellValue As Variant
Private DateCellValue As Variant

' Called by the Workbook Open event.
' Note that the worksheet has to be specified. It's preferable to use
' the code name to allow changing the (tab) name.
Sub PopulateVariables()
    ChangeCellValue = Sheet1.Range(CHANGE_CELL).Value ' adjust the sheet!
    DateCellValue = Sheet1.Range(DATE_CELL).Value ' adjust the sheet!
End Sub

' Called by the Worksheet Change event.
' If you select a cell and click into the formula bar and press enter
' or you double-click the cell and press enter, you haven't changed
' the value but the Worksheet Change event got triggered anyway.
' That is the meaning of an invalid change.
Sub DateChange(ByVal Target As Range)
    On Error GoTo ClearError
    
    Dim cCell As Range, dCell As Range, HaveValuesChanged As Boolean
    
    With Target.Worksheet
        Set cCell = .Range(CHANGE_CELL)
        Set dCell = .Range(DATE_CELL)
    End With
    
    Dim Today As Date: Today = Now ' when done testing, use 'Date'
    
    ' Handle change in Change cell.
    If Not Intersect(cCell, Target) Is Nothing Then ' change detected
        If CStr(cCell.Value) <> CStr(ChangeCellValue) Then ' valid change
            Application.EnableEvents = False ' to not retrigger the event
            If IsEmpty(cCell) Then
                DateCellValue = Empty
                dCell.Value = DateCellValue
            Else
                If CStr(dCell.Value) <> CStr(Today) Then ' date is different
                    DateCellValue = Today
                    dCell.Value = DateCellValue
                'Else ' date is the same; do nothing
                End If
            End If
            ChangeCellValue = cCell.Value
            HaveValuesChanged = True
        'Else ' invalid change; do nothing
        End If
    'Else ' no change detected; do nothing
    End If
    
    ' Handle change in Date cell.
    If Not HaveValuesChanged Then ' previous invalid change or no change
        If Intersect(dCell, Target) Is Nothing Then Exit Sub ' no ch. detected
        If CStr(dCell.Value) <> CStr(DateCellValue) Then ' valid change
            Application.EnableEvents = False ' to not retrigger the event
            dCell.Value = DateCellValue
        'Else ' invalid change; do nothing
        End If
    End If
    
ProcExit:
    On Error Resume Next
        If Not Application.EnableEvents Then Application.EnableEvents = True
    On Error GoTo 0
    Exit Sub
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "':" & vbLf & Err.Description
    Resume ProcExit
End Sub