Convert formula to value once formula has calculated

user_15689295 0
Viewed 102

I'm using the following VBA module to create a Timestamp UDF, which stamps the date once the referenced cell reads "Done":

Function Timestamp(Reference As Range)
    If Reference.Value = "Done" Then
        Timestamp = Format(Date, "ddd dd mmm")
    Else
        Timestamp = ""
    End If
End Function

The date stays the same even after refreshing / closing and opening the workbook as long as the referenced cell still reads "Done"; however if someone accidentally changes the referenced cell then the date is reset.

I need a VBA code to convert the formula to value once it has calculated, so the date will always stay the same. The solution needs to be automatic rather than manual and I can't enable iterative formulas on this workbook because it's used by multiple users. Any help much appreciated!

vba excel
1 Answers

You can use the Worksheet Change event for that:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim AffectedCells As Range
    Set AffectedCells = Intersect(Target, Me.Range("A:A"))  ' Range A:A is the range we observe for 'done'
    
    If AffectedCells Is Nothing Then Exit Sub
    
    Dim Cell As Range
    For Each Cell In AffectedCells
        If Cell.Value = "done" Then
            Dim UpdateTimestamp As Boolean
            UpdateTimestamp = True
            
            If Range("B" & Cell.Row).Value <> vbNullString Then
                UpdateTimestamp = MsgBox("Timestamp exists do you want to update it?", vbQuestion + vbYesNo) = vbYes
            End If
            
            If UpdateTimestamp Then
                Me.Range("B" & Cell.Row).Value = Format$(Date, "ddd dd mmm")
            End If
        End If
    Next Cell
    
End Sub

enter image description here

// Edit according comment:

If you want to check multiple ranges for different things you need to slightly change your code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cell As Range

    Dim ObservedRangeA As Range
    Set ObservedRangeA = Intersect(Target, Me.Range("A:A"))  ' Range A:A is the range we observe for 'done'
    
    If Not ObservedRangeA Is Nothing Then
        For Each Cell In ObservedRangeA 
            If Cell.Value = "done" And Range("B" & Cell.Row).Value = vbNullString Then
                Me.Range("B" & Cell.Row).Value = Format$(Date, "ddd dd mmm")
            End If
        Next Cell
    End If

    Dim ObservedRangeB As Range
    Set ObservedRangeB = Intersect(Target, Me.Range("C:C"))  ' Range C:C is the range we observe for ""
    
    If Not ObservedRangeB Is Nothing Then
        For Each Cell In ObservedRangeB 
            If Cell.Value = "" And Range("B" & Cell.Row).Value = vbNullString Then
                Me.Range("B" & Cell.Row).Value = Format$(Date, "ddd dd mmm")
            End If
        Next Cell
    End If

End Sub
user_32196130
Related