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"?

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"?

• excel
• vba
• changelog

• 1 Use Range.Formula instead of Range.Value – CHill60 Commented Feb 3 at 9:28

1 Answer 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