VBA Code to Track Sheet Changes

C

coreyalaurence39

New Member
Joined
Mar 10, 2022
Messages
20
Office Version
  1. 2019
Platform
  1. Windows
VBA Code: 
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

I have the above code set up to track changes to specific cells. Is it possible to add a case that will track changes in cells A5 to P1000 within the sheet and enter the changes to a sheet called Log Details. I am not sure how to manipulate the above code to do this.
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Sort by date Sort by votes
Should be what you asked for:
VBA Code: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("A5:P1000")) Is Nothing Then '<- added, check if range A5:P1000
        Sheets("Log Details").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(, 4).Value = Array(Environ("UserName"), Target.Address, Target.Value, Now()) '<- added
    Else                                          '<- added, if not range A5:P1000 go on to previous macro
        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
    End If                                        '<- added
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
rollis13 said:
Should be what you asked for:
VBA Code: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("A5:P1000")) Is Nothing Then '<- added, check if range A5:P1000
        Sheets("Log Details").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(, 4).Value = Array(Environ("UserName"), Target.Address, Target.Value, Now()) '<- added
    Else                                          '<- added, if not range A5:P1000 go on to previous macro
        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
    End If                                        '<- added
    Application.ScreenUpdating = True
End Sub
Click to expand...
Thank you so much this is working great. Is there a way to add what the old value was before the change. I was also interested in knowing if it could also capture when a formula is altered and what the old and new formula is.
 
Upvote 0
You could use this but will work correctly only if you move from one cell to another before a change of contents in the cell.
VBA Code: 
Option Explicit
Public OldData
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("A5:P1000,I2,L2,P2")) Is Nothing Then OldData = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("A5:P1000")) Is Nothing Then
        Application.ScreenUpdating = False
        Sheets("Log Details").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(, 5).Value = Array(Environ("UserName"), Target.Address, OldData, Target.Value, Now())
    Else
        If Intersect(Target, Range("I2,L2,P2")) Is Nothing Then Exit Sub
        Application.ScreenUpdating = False
        Select Case Target.Column
            Case Is = 9
                Sheets("DispatcherTracking").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(, 5).Value = Array(Environ("UserName"), Target.Address, OldData, Target.Value, Now())
            Case Is = 12
                Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(, 5).Value = Array(Environ("UserName"), Target.Address, OldData, Target.Value, Now())
            Case Is = 16
                Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(, 5).Value = Array(Environ("UserName"), Target.Address, OldData, Target.Value, Now())
        End Select
    End If
    Application.ScreenUpdating = True
End Sub
Detecting when a formula is updated is a completely different case, per forum rules I suppose you should open a new thread with new topic.
 
Last edited:
Upvote 0
Solution
rollis13 said:
You could use this but will work correctly only if you move from one cell to another before a change of contents in the cell.
VBA Code: 
Option Explicit
Public OldData
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("A5:P1000,I2,L2,P2")) Is Nothing Then OldData = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("A5:P1000")) Is Nothing Then
        Application.ScreenUpdating = False
        Sheets("Log Details").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(, 5).Value = Array(Environ("UserName"), Target.Address, OldData, Target.Value, Now())
    Else
        If Intersect(Target, Range("I2,L2,P2")) Is Nothing Then Exit Sub
        Application.ScreenUpdating = False
        Select Case Target.Column
            Case Is = 9
                Sheets("DispatcherTracking").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(, 5).Value = Array(Environ("UserName"), Target.Address, OldData, Target.Value, Now())
            Case Is = 12
                Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(, 5).Value = Array(Environ("UserName"), Target.Address, OldData, Target.Value, Now())
            Case Is = 16
                Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(, 5).Value = Array(Environ("UserName"), Target.Address, OldData, Target.Value, Now())
        End Select
    End If
    Application.ScreenUpdating = True
End Sub
Detecting when a formula is updated is a completely different case, per forum rules I suppose you should open a new thread with new topic.
Click to expand...
Thank you for your help but I am receiving the error that is attached in the photo.
 

Attachments

  • Screenshot 2022-03-25 082058.jpg
    Screenshot 2022-03-25 082058.jpg
    142.5 KB · Views: 8
Upvote 0
Did you paste all the code (post #4) in the sheet's module ? did you delete/substitute all the old code (post #2) ?
On which line does the debug stop (it's highlighted yellow) ? which variable does it highlight (blu) ?
 
Upvote 0
rollis13 said:
Did you paste all the code (post #4) in the sheet's module ? did you delete/substitute all the old code (post #2) ?
On which line does the debug stop (it's highlighted yellow) ? which variable does it highlight (blu) ?
Click to expand...
Thank you it seems to be working now.
 
Upvote 0
Certainly, no doubt :eek:. Thanks for the positive feedback(y), glad having been of some help. Good luck with the thread regarding formulas.
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Question
VBA Code to record changes/logs modification needed?
Replies
0
Views
78
FGaxha
F
S
  • Question
I have a problem in audit trail with VBA
Replies
1
Views
157
Joe4
Joe4
S
  • Solved
Working with multiple Target Ranges in Worksheet Code
Replies
3
Views
398
sspatriots
S
S
  • Question
Worksheet Change Event
Replies
2
Views
393
sspatriots
S
S
  • Solved
Need to have Worksheet_Change event include value from another column using structured reference
Replies
4
Views
312
Alex Blakenburg
A

Forum statistics

Threads
1,215,426
Messages
6,124,828
Members
449,190
Latest member
rscraig11

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top