Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Range("Data_Range")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim New_Value As Double, New_Sum As Double
Dim Old_Sum As Variant, Old_Value As Variant
Dim Changed_Address As String
Dim dr As Range, oc As Range
Dim aud As Worksheet, ds As Worksheet
' This is a hidden worksheet which will preserve a history of changes in the data
Set aud = ThisWorkbook.Worksheets("Audit Trail")
' This is the sheet which has the data range , change as required
Set ds = ThisWorkbook.Worksheets("Sheet1")
ds.Activate
Set dr = ActiveSheet.Range("Data_Range") ' Data_Range is a named range
Set oc = ActiveSheet.Range("Output_Cell") ' Output_Cell is a named range
Old_Sum = oc.Value
New_Value = Val(Target)
Application.Undo
Old_Value = ActiveSheet.Range(Target.Address).Value
If IsEmpty(Old_Sum) Then Old_Sum = Val(Application.WorksheetFunction.Sum(dr))
Target = New_Value
New_Sum = Old_Sum + New_Value
Changed_Address = Target.Address
aud.Activate
Call Copy_to_Audit_Trail(Changed_Address, Old_Value, New_Value)
ds.Activate
oc.Value = New_Sum
Set dr = Nothing
Set oc = Nothing
Set aud = Nothing
Set ds = Nothing
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Public Sub Copy_to_Audit_Trail(celladd As String, oldval As Variant, newval As Double)
Dim last As Long
With ActiveSheet
last = .Cells(.Rows.Count, "A").End(xlUp).Row
With .Range("A1")
.Offset(last, 0) = celladd
.Offset(last, 1) = oldval
.Offset(last, 2) = newval
End With
End With
End Sub