Event Change code

[karen]

I want to be able to track changes made to a spreadsheet by users by changing
the colour of the cells.

worksheet name is cost by vehicle and the range that needs to be covered is
G1:k800. I'd like any cells changed to change to a red background.

I know this is a worksheet change event, but I don't have any idea how to do
it. Can anyone point me in the right direction please.

 

[ryguy7272]

there are MANY ways to do this. Take a look at these options:
Private Sub Worksheet_Change(ByVal Target As Range)
Set r = Range("a1:iv65536")
If Intersect(Target, r) Is Nothing Then Exit Sub
Application.EnableEvents = False
Cells(Target.Row, "Z").Value = Environ("username")
Application.EnableEvents = True
End Sub
(In a sheet, not a module)

Function MyUserName() As String
MyUserName = Environ("UserName")
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("$A$1:$BB$4000")) Is Nothing Then
Application.EnableEvents = False
Application.ScreenUpdating = False
With Worksheets("Sheet2")
..Select
..Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = Target.Address
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Target.Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Now()
ActiveCell.NumberFormat = "mm/dd/yy"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = MyUserName()
Application.EnableEvents = True
Application.ScreenUpdating = True
End With
End If
End Sub
(In a sheet, not a module)


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("A2:A10"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
With .Offset(0, 1)
.NumberFormat = "dd mmm yyyy hh:mm:ss"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
End Sub
(In a sheet, not a module)


Regards,
Ryan---

 

[Jim Thomlinson]

Right click the sheet you wnat to colour code and add the following...

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Intersect(Target, Range("G1:K800")).Interior.ColorIndex = 3
On Error GoTo 0
End Sub