Automatic date update in a cell when another cell's value changes (as calculated by a formula)

后端 未结 4 457
佛祖请我去吃肉
佛祖请我去吃肉 2020-12-17 02:50

I have a formula in C2, say =A2+B2. Whenever C2 changes value (actual value, not formula) I want to have the present date and time updated in D2.

I have

相关标签:
4条回答
  • 2020-12-17 03:37
    Private Sub Worksheet_Change(ByVal Target As Range)
    
        If Target.Address = "$C$2" Then
    
            ActiveSheet.Range("D2").Value = Now()
    
        End If
    
    End Sub
    
    0 讨论(0)
  • 2020-12-17 03:41

    The simplest way is to add =IF(B3="","Not Allocated",Now()) and change the format of the column to the required date and time format. But here if the B column is edited, the date and time of the respective column that needs the update will gets updated automatically for all the columns since not checking the old value. But if it is fine to get current Time this can be easily used.

    0 讨论(0)
  • 2020-12-17 03:43

    You could fill the dependend cell (D2) by a User Defined Function (VBA Macro Function) that takes the value of the C2-Cell as input parameter, returning the current date as ouput.

    Having C2 as input parameter for the UDF in D2 tells Excel that it needs to reevaluate D2 everytime C2 changes (that is if auto-calculation of formulas is turned on for the workbook).

    EDIT:

    Here is some code:

    For the UDF:

        Public Function UDF_Date(ByVal data) As Date
    
            UDF_Date = Now()
    
        End Function
    

    As Formula in D2:

    =UDF_Date(C2)
    

    You will have to give the D2-Cell a Date-Time Format, or it will show a numeric representation of the date-value.

    And you can expand the formula over the desired range by draging it if you keep the C2 reference in the D2-formula relative.

    Note: This still might not be the ideal solution because every time Excel recalculates the workbook the date in D2 will be reset to the current value. To make D2 only reflect the last time C2 was changed there would have to be some kind of tracking of the past value(s) of C2. This could for example be implemented in the UDF by providing also the address alonside the value of the input parameter, storing the input parameters in a hidden sheet, and comparing them with the previous values everytime the UDF gets called.

    Addendum:

    Here is a sample implementation of an UDF that tracks the changes of the cell values and returns the date-time when the last changes was detected. When using it, please be aware that:

    • The usage of the UDF is the same as described above.

    • The UDF works only for single cell input ranges.

    • The cell values are tracked by storing the last value of cell and the date-time when the change was detected in the document properties of the workbook. If the formula is used over large datasets the size of the file might increase considerably as for every cell that is tracked by the formula the storage requirements increase (last value of cell + date of last change.) Also, maybe Excel is not capable of handling very large amounts of document properties and the code might brake at a certain point.

    • If the name of a worksheet is changed all the tracking information of the therein contained cells is lost.

    • The code might brake for cell-values for which conversion to string is non-deterministic.

    • The code below is not tested and should be regarded only as proof of concept. Use it at your own risk.

      Public Function UDF_Date(ByVal inData As Range) As Date
      
          Dim wb As Workbook
          Dim dProps As DocumentProperties
          Dim pValue As DocumentProperty
          Dim pDate As DocumentProperty
          Dim sName As String
          Dim sNameDate As String
      
          Dim bDate As Boolean
          Dim bValue As Boolean
          Dim bChanged As Boolean
      
          bDate = True
          bValue = True
      
          bChanged = False
      
      
          Dim sVal As String
          Dim dDate As Date
      
          sName = inData.Address & "_" & inData.Worksheet.Name
          sNameDate = sName & "_dat"
      
          sVal = CStr(inData.Value)
          dDate = Now()
      
          Set wb = inData.Worksheet.Parent
      
          Set dProps = wb.CustomDocumentProperties
      
      On Error Resume Next
      
          Set pValue = dProps.Item(sName)
      
          If Err.Number <> 0 Then
              bValue = False
              Err.Clear
          End If
      
      On Error GoTo 0
      
          If Not bValue Then
              bChanged = True
              Set pValue = dProps.Add(sName, False, msoPropertyTypeString, sVal)
          Else
              bChanged = pValue.Value <> sVal
              If bChanged Then
                  pValue.Value = sVal
              End If
          End If
      
      On Error Resume Next
      
          Set pDate = dProps.Item(sNameDate)
      
          If Err.Number <> 0 Then
              bDate = False
              Err.Clear
          End If
      
      On Error GoTo 0
      
          If Not bDate Then
              Set pDate = dProps.Add(sNameDate, False, msoPropertyTypeDate, dDate)
          End If
      
          If bChanged Then
              pDate.Value = dDate
          Else
              dDate = pDate.Value
          End If
      
      
          UDF_Date = dDate
       End Function
      
    0 讨论(0)
  • 2020-12-17 03:43

    Make the insertion of the date conditional upon the range.

    This has an advantage of not changing the dates unless the content of the cell is changed, and it is in the range C2:C2, even if the sheet is closed and saved, it doesn't recalculate unless the adjacent cell changes.

    Adapted from this tip and @Paul S answer

    Private Sub Worksheet_Change(ByVal Target As Range)
     Dim R1 As Range
     Dim R2 As Range
     Dim InRange As Boolean
        Set R1 = Range(Target.Address)
        Set R2 = Range("C2:C20")
        Set InterSectRange = Application.Intersect(R1, R2)
    
      InRange = Not InterSectRange Is Nothing
         Set InterSectRange = Nothing
       If InRange = True Then
         R1.Offset(0, 1).Value = Now()
       End If
         Set R1 = Nothing
         Set R2 = Nothing
     End Sub
    
    0 讨论(0)
提交回复
热议问题