Tracking my employee's history of changes.

[ZEUSZEUS]

Have a dilemma.
I am using excel as point of sale book (to record customer name, service, and total price etc.) at our hair salon. We have employees that may be there to manage alone from time to time, and enter clients into excel.
Our worry is straight forward, and involves them erasing what they wrote. I am confident that the actual service and price is entered at the beginning, but want to track their changes to their own entries.

The "track changes" would work if it "tracked changes" after entry. But it seems to track the last change from saving. For example....the employee enters $40.25 presses enter--after she knows she can get away with a change, she may erase it altogether or change it to say $16.75.

Please help.
Thanks in advance

 

[VoG]

This just writes Saved in column G whenever the file is saved (manually or automatically).

 

[ZEUSZEUS]

What a noob I am----I should be able to read some code by now!

So I guess making the file save when a certain column's cell is entered is not an easy fix?

Tom.

 

[VoG]

So I guess making the file save when a certain column's cell is entered is not an easy fix?

Should be easy enough. Which column?

 

[ZEUSZEUS]

Column "P"

 

[VoG]

Try this

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim LR As Long, X As Variant
If Sh.Name = "Log" Then Exit Sub
X = Target.Value
With Application
    .EnableEvents = False
    .ScreenUpdating = False
    If Target.Count = 1 Then .Undo
End With
With Sheets("Log")
    .Unprotect Password:="pw"
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A" & LR + 1).Value = Now
    .Range("B" & LR + 1).Value = Sh.Name
    .Range("C" & LR + 1).NumberFormat = "@"
    .Range("C" & LR + 1).Value = Target.Address(False, False)
    .Range("D" & LR + 1).Value = Target.Value
    .Range("E" & LR + 1).Value = X
    .Range("F" & LR + 1).Value = Environ("username")
    .Protect Password:="pw"
End With
If Target.Count = 1 Then Target.Value = X
On Error Resume Next
Target.Offset(, 1).Select
On Error GoTo 0
With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With
If Target.Column = 16 Then ThisWorkbook.Save
End Sub

 

[Aleciafxc]

I have a hitch, how can i say if x = formula then to not log. So here is the problem I have many tables. When a new person is entered the Table automatically generates the formulas need, the logger will overwrite the formulas and place values. So i need the logger to ignore all formulas. Any Ideas. Also is there a way to say if a certain user opens the database not to run the logger at all. I have been playing with if Enviorn (User) = "anissen" then Exit Sub.


Thanks
Alecia

 

[VoG]

Try this

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim LR As Long, X As Variant
If Environ("username") = "anissen" Then Exit Sub
If Sh.Name = "Log" Then Exit Sub
If Target.HasFormula Then Exit Sub
X = Target.Value
With Application
    .EnableEvents = False
    .ScreenUpdating = False
    If Target.Count = 1 Then .Undo
End With
With Sheets("Log")
    .Unprotect Password:="pw"
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A" & LR + 1).Value = Now
    .Range("B" & LR + 1).Value = Sh.Name
    .Range("C" & LR + 1).NumberFormat = "@"
    .Range("C" & LR + 1).Value = Target.Address(False, False)
    .Range("D" & LR + 1).Value = Target.Value
    .Range("E" & LR + 1).Value = X
    .Range("F" & LR + 1).Value = Environ("username")
    .Protect Password:="pw"
End With
If Target.Count = 1 Then Target.Value = X
On Error Resume Next
Target.Offset(, 1).Select
On Error GoTo 0
With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With
If Target.Column = 16 Then ThisWorkbook.Save
End Sub

 

[Aleciafxc]

Thanks a million.

 

[Aleciafxc]

A change in Plans. My Database has grown much and do not neet to track changes on all sheets, but if I add if Sheet Name is such and such the exit sub (there are many) it takes way to long tooooo run. So I just added the macro to the individual sheet code and it works great except it does not record the previous value. Again any assistance will be appreciated.

Thanks
Alecia

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LR As Long, x As Variant
If Environ("username") = "aarcher" Then Exit Sub
If Environ("username") = "Executive Director" Then Exit Sub
If Target.HasFormula Then Exit Sub
x = Target.Value
With Application
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
On Error Resume Next

.Undo

End With
With Sheets("Log")
.Unprotect Password:="myfadra"
LR = .Range("A" & Rows.Count).End(xlUp).row
.Range("A" & LR + 1).Value = Now
.Range("B" & LR + 1).Value = "PP"
.Range("C" & LR + 1).NumberFormat = "@"
.Range("C" & LR + 1).Value = Target.Address(False, False)
.Range("D" & LR + 1).Value = Target.Value
.Range("E" & LR + 1).Value = x
.Range("F" & LR + 1).Value = Environ("username")
.Protect Password:="myfadra"
End With
Target.Value = x
Target.Offset(, 0).Select
With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

 

[Ed in Aus]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LR As Long, x As Variant
If Environ("username") = "aarcher" Then Exit Sub
If Environ("username") = "Executive Director" Then Exit Sub
If Target.HasFormula Then Exit Sub
x = Target.Value
With Application
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
On Error Resume Next

.Undo
y = Target.Value 'here is the previous value
End With
With Sheets("Log")
.Unprotect Password:="myfadra"
LR = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A" & LR + 1).Value = Now
.Range("B" & LR + 1).Value = "PP"
.Range("C" & LR + 1).NumberFormat = "@"
.Range("C" & LR + 1).Value = Target.Address(False, False)
.Range("D" & LR + 1).Value = Target.Value
.Range("E" & LR + 1).Value = x
.Range("F" & LR + 1).Value = Environ("username")
.Protect Password:="myfadra"
End With
Target.Value = x
Target.Offset(, 0).Select
With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
'Just so you can test it, this can be removed
MsgBox x 
MsgBox y


End Sub