I have a vba macro that logs any changes in a worksheet, but i would like to do it in a different way. If someone wants to calculate something in a cell, f.e. =1+1, the macro do the logging and we only get back the value 2.
The macro that i have:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RangeValues As Variant
Dim r As Long
Dim boolOne As Boolean
Dim TgValue
Dim sh As Worksheet
Set sh = Worksheets("changelog")
sh.Visible = True
Dim UN As String
UN = Application.UserName
sh.Unprotect ""
If sh.Range("A1") = "" Then sh.Range("A1").Resize(1, 6) = _
Array("Time", "User Name", "Changed cell", "From", "To", "Sheet Name")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Target.Cells.count > 1 Then
TgValue = extractData(Target)
Else
TgValue = Array(Array(Target.Value, Target.Address(0, 0)))
boolOne = True
End If
Application.EnableEvents = False
Application.Undo
RangeValues = extractData(Target)
putDataBack TgValue, ActiveSheet
If boolOne Then Target.Offset(1).Select
Application.EnableEvents = True
Dim columnHeader As String
Dim rowHeader As String
For r = 0 To UBound(RangeValues)
If RangeValues(r)(0) <> TgValue(r)(0) Then
sh.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Resize(1, 6).Value = _
Array(Now, UN, RangeValues(r)(1), RangeValues(r)(0), TgValue(r)(0), Target.Parent.Name)
End If
Next r
sh.Protect ""
sh.Visible = xlSheetVeryHidden
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub putDataBack(arr, sh As Worksheet)
Dim i As Long, arrInt, El
For Each El In arr
sh.Range(El(1)).Value = El(0)
Next
End Sub
Function extractData(rng As Range) As Variant
Dim a As Range, arr, count As Long, i As Long
ReDim arr(rng.Cells.count - 1)
For Each a In rng.Areas
For i = 1 To a.Cells.count
arr(count) = Array(a.Cells(i).Value, a.Cells(i).Address(0, 0)): count = count + 1
Next
Next
extractData = arr
End Function
Is there any way to get back the data 2 in the form of "=1+1"?
Try this version :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RangeValues As Variant
Dim r As Long
Dim boolOne As Boolean
Dim TgValue
Dim sh As Worksheet
Set sh = Worksheets("changelog")
sh.Visible = True
Dim UN As String
UN = Application.UserName
sh.Unprotect ""
If sh.Range("A1") = "" Then sh.Range("A1").Resize(1, 6) = _
Array("Time", "User Name", "Changed cell", "From", "To", "Sheet Name")
Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual ' leave if necessary
If Target.Cells.count > 1 Then
TgValue = extractData(Target)
Else
TgValue = Array(Array(Target.Formula, Target.Address(0, 0))) ' Value replaced
boolOne = True
End If
Application.EnableEvents = False
Application.Undo
RangeValues = extractData(Target)
putDataBack TgValue, ActiveSheet
If boolOne Then Target.Offset(1).Select
Application.EnableEvents = True
Dim columnHeader As String
Dim rowHeader As String
For r = 0 To UBound(RangeValues)
If RangeValues(r)(0) <> TgValue(r)(0) Then
sh.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Resize(1, 6).Value = _
Array(Now, UN, RangeValues(r)(1), "'" & RangeValues(r)(0), "'" & _
TgValue(r)(0), Target.Parent.Name) ' added single quotes
End If
Next r
sh.Protect ""
sh.Visible = xlSheetVeryHidden
'Application.Calculation = xlCalculationAutomatic ' leave if necessary
Application.ScreenUpdating = True
End Sub
Sub putDataBack(arr, sh As Worksheet)
Dim i As Long, arrInt, El
For Each El In arr
sh.Range(El(1)).Formula = El(0) ' Value replaced
Next
End Sub
Function extractData(rng As Range) As Variant
Dim a As Range, arr, count As Long, i As Long
ReDim arr(rng.Cells.count - 1)
For Each a In rng.Areas
For i = 1 To a.Cells.count
arr(count) = Array(a.Cells(i).Formula, a.Cells(i).Address(0, 0)) ' Value replaced
count = count + 1
Next
Next
extractData = arr
End Function