VBA Code to Track changes

[coreyalaurence39]

I am using the code below to tack changes to a cell in my worksheet. I need to this be done on multiple cells (ex. I2, L2, and P2) but I need to changes to be in three different sheets, so I2 would have it's own sheet, L2 it's own sheet and P2 it's own sheet. How would I do this in excel with the code below?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rw As Long
Dim strAddress As String
Dim strUserName As String
Dim dtmTime As Date
Dim v As Variant

If Intersect(Target, Range("I2")) Is Nothing Then Exit Sub
If Target.Address = Target.EntireRow.Address Then
    Sheets("DispatcherTracking").Rows(Target.Row).Insert
    If Application.CountA(Target) = 0 Then Exit Sub
End If
dtmTime = Now()
v = Target.Value
strAddress = Target.Address
strUserName = Environ("UserName")

Rw = Sheets("DispatcherTracking").Range("A" & Rows.Count).End(xlUp).Row + 1
With Sheets("DispatcherTracking")
    .Cells(Rw, 1) = strUserName
    .Cells(Rw, 2) = strAddress
    .Cells(Rw, 3) = v
    .Cells(Rw, 4) = dtmTime

End With

End Sub

 

[mumps]

Try this version. Change the sheet names (in red for L2, in blue for P2) to suit your needs.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("I2,L2,P2")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Select Case Target.Column
        Case Is = 9
            With Sheets("DispatcherTracking")
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 4).Value = Array(Environ("UserName"), Target.Address, Target.Value, Now())
            End With
        Case Is = 12
            With Sheets("Sheet1")
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 4).Value = Array(Environ("UserName"), Target.Address, Target.Value, Now())
            End With
        Case Is = 16
            With Sheets("Sheet2")
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 4).Value = Array(Environ("UserName"), Target.Address, Target.Value, Now())
            End With
    End Select
    Application.ScreenUpdating = True
End Sub

 

[coreyalaurence39]

I want to use the code below to track any changes made in my sheet but I only want it to track from cell A5 to P5 and down. I also would like it to tack when a formula is changed. It would also be nice if it would track the old value in the cells and the new value that it was changed to. I just do not know how to manipulate this code to do what I want it to do.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rw As Long
Dim strAddress As String
Dim strUserName As String
Dim dtmTime As Date
Dim v As Variant

If Intersect(Target, Range("I2")) Is Nothing Then Exit Sub
If Target.Address = Target.EntireRow.Address Then
Sheets("DispatcherTracking").Rows(Target.Row).Insert
If Application.CountA(Target) = 0 Then Exit Sub
End If
dtmTime = Now()
v = Target.Value
strAddress = Target.Address
strUserName = Environ("UserName")

Rw = Sheets("DispatcherTracking").Range("A" & Rows.Count).End(xlUp).Row + 1
With Sheets("DispatcherTracking")
.Cells(Rw, 1) = strUserName
.Cells(Rw, 2) = strAddress
.Cells(Rw, 3) = v
.Cells(Rw, 4) = dtmTime

End With

End Sub[/CODE]