Reputation: 23
I am using an audit trail to record changes effected on Sheet One and record them on Sheet 2. The code works fine however, I would like to restrict the code to run only on specific cells i.e. (A1:L100). The reason is that I have some workings from column M onwards and so I do not want to record any movements in these workings. Any suggestion on what to add/amend to the following code:
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("D" & Split(cellAddress, "$")(2)).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
Upvotes: 1
Views: 1398
Reputation: 50034
In Write_Change
you can test your cellAddress
to see if it's something you want to write about. For instance, if you only wanted to capture changed in A1:F50
you could write:
If Not(Intersect(Me.Range(cellAddress), me.Range("A1:F50")) IS NOTHING) Then
Write_Change = False
Exit Function
End If
Or something along those lines. If your range of acceptable cells is made up of multiple areas, you can check out the UNION
function to stitch them into a single range that you can test with that IF Not(Intersect() Is Nothing))
logic.
Upvotes: 1