Stefano Lazze'
Stefano Lazze'

Reputation: 23

Apply VBA Code on specific cells

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

Answers (1)

JNevill
JNevill

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

Related Questions