There may be a better way to do this, but this is what came to my mind:
In Profile Sheet Module
Option Explicit
Public dArr As Variant
Private Sub Worksheet_Calculate()
Dim nArr As Variant
Dim auditRecord As Range
Dim i As Long
Dim j As Long
nArr = Me.UsedRange
'Look for changes to the used range
For i = 1 To UBound(dArr, 2)
For j = 1 To UBound(dArr, 1)
If nArr(j, i) <> dArr(j, i) Then
'write to range
If Not Write_Change(dArr(j, i), nArr(j, i), Me.Cells(j, i).Address) Then
MsgBox "The change was not recorded.", vbInformation
End If
End If
Next j
Next i
Erase nArr, dArr
dArr = Me.UsedRange
End Sub
Private Sub Worksheet_Change(ByVal target As Range)
Dim Cell As Range
Dim oldValue As Variant
For Each Cell In target
On Error Resume Next
oldValue = vbNullString
oldValue = dArr(Cell.Row, Cell.Column)
On Error GoTo 0
If oldValue <> Cell.Value Then
If Not Write_Change(oldValue, Cell.Value, Cell.Address) Then
MsgBox "The change was not recorded.", vbInformation
End If
End If
Next Cell
On Error Resume Next
Erase dArr
On Error GoTo 0
dArr = Me.UsedRange
End Sub
Private Sub Worksheet_SelectionChange(ByVal target As Range)
dArr = Me.UsedRange
End Sub
Public Function Write_Change(oldValue, newValue, cellAddress As String) As Boolean
Dim auditRecord As Range
On Error GoTo errHandler
Set auditRecord = Sheets("ChangeHistory").Range("A:A").Find("*", searchdirection:=xlPrevious).Offset(1, 0)
With auditRecord
.Value = cellAddress 'Address of change
.Offset(0, 1).Value = newValue 'new value
.Offset(0, 2).Value = oldValue 'previous value
.Offset(0, 3).NumberFormat = "dd mm yyyy hh:mm:ss"
.Offset(0, 3).Value = Now 'time of change
.Offset(0, 4).Value = Application.UserName 'user who made change
.Offset(0, 5).Value = Me.Range(Split(cellAddress, "$")(1) & 1).Value 'header column value
.Offset(0, 6).Value = Me.Range("D" & Split(cellAddress, "$")(2)).Value 'header row value
End With
Write_Change = True
Exit Function
errHandler:
Write_Change = False
Debug.Print "Error number: " & Err.Number
Debug.Print "Error descr: " & Err.Description
End Function
In ThisWorkbook Module
Private Sub Workbook_Open()
dArr = Sheets("Profile").UsedRange
End Sub
Explanation
The key to this solution is the public array dArr. The array will hold a static list of values from your sheet in memory and will update anytime you make a different selection on your worksheet using the SelectionChange event.
We use the Calculate event to handle times where formulas update cells' contents. To do this, we store the new values on the sheet in an array nArr and then loop through the array and compare the values against the static values in dArr.
Pasted values or manually added values will be captured using the Change event.
For this to work, dArr has to be filled anytime the workbook is opened by a user. To do this, you'll have to add this to the Workbook_Open event as shown above.
Other Notes
As noted here by Tim, there are times when global variables can lose their values by way of unhandled errors, so make sure to include good error handling in this project if you choose to use this solution.
This only writes value changes. Formatting changes will not be captured using this method.
Will not work if there's only one value on the Profile sheet. Could be modified to work like that if needed though.
I did some minor testing of the above code in 64-bit excel-2013, but you may want to do more extensive testing to ensure that all changes are captured via the above code.
