Track users who use excel file

[ShieBoon]

Hello, do you guys know of any code that can allow me to track the users who use a shared excel file and log the records in a worksheet within the file?

i'm using xl 2003

 

[Damo10]

Hi,

I am getting somewhere now with a lot of help from yourself.

The part of the code below does not work within this sheet and does not add any info to the log sheet but if I remove it it works but does not do that check

If OldVal <> NewVal Then

The other issue that I have found is that when I run my clear report macro I get a run timer error 13 - type mismatch

Can this code be modified so that when I run this clear sheet code that it does not do anything with this workbook sheet change code?

Thanks a lot for your help so far

Regards Damain

 

[VoG]

I'm not sure why the OldVal <> NewVal would't work.

To avoid the error when changing multiple cells try

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim LR As Long, NewVal As Variant, OldVal As Variant
If Target.Count > 1 Then Exit Sub
If Sh.Name = "Log" Then Exit Sub
If Not Intersect(Target, Range("Data")) Is Nothing Then Exit Sub
Application.EnableEvents = False
NewVal = Target.Value
Application.Undo
OldVal = Target.Value
Target.Value = NewVal
If OldVal <> NewVal Then
    With Sheets("Log")
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A" & LR + 1).Value = VBA.Environ("username") 'user
        .Range("B" & LR + 1).Value = Now 'date and time
        .Range("C" & LR + 1).Value = Sh.Name 'sheet
        .Range("D" & LR + 1).Value = Target.Address(False, False) 'cell
        .Range("E" & LR + 1).Value = OldVal 'previous value
        .Range("F" & LR + 1).Value = Target.Value 'new value
    End With
End If
Application.EnableEvents = True
End Sub

 

[Damo10]

Hi,

I still cant get the old cell data to work as it does not copy anything into the Log sheet. If I remove the

If OldVal <> NewVal Then

then it will copy all of the data but the old and new data values are the same

Here is the code I am currently using

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim LR As Long, NewVal As Variant, OldVal As Variant
Dim cell As Range
If Target.Count > 1 Then Exit Sub
If Sh.Name = "Log" Then Exit Sub
Application.EnableEvents = False
NewVal = Target.Value
Set cell = ActiveCell
On Error Resume Next
Application.Undo
OldVal = Target.Value
Target.Value = NewVal
If OldVal <> NewVal Then
    With Sheets("Log")
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A" & LR + 1).Value = VBA.Environ("username") 'user
        .Range("B" & LR + 1).Value = Now 'date and time
        .Range("C" & LR + 1).Value = Sh.Name 'sheet
        .Range("D" & LR + 1).Value = Target.Address(False, False) 'cell
        .Range("E" & LR + 1).Value = OldVal 'previous value
        .Range("F" & LR + 1).Value = Target.Value 'new value
    End With
End If
cell.Select
Application.EnableEvents = True
End Sub

Regards

 

[VoG]

It (the code that I posted) works for me. Perhaps it has something to do with the redundant (and incorrect) code that you have added

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim LR As Long, NewVal As Variant, OldVal As Variant
Dim cell As Range
If Target.Count > 1 Then Exit Sub
If Sh.Name = "Log" Then Exit Sub
Application.EnableEvents = False
NewVal = Target.Value
Set cell = ActiveCell
On Error Resume Next
Application.Undo
OldVal = Target.Value
Target.Value = NewVal
If OldVal <> NewVal Then
    With Sheets("Log")
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A" & LR + 1).Value = VBA.Environ("username") 'user
        .Range("B" & LR + 1).Value = Now 'date and time
        .Range("C" & LR + 1).Value = Sh.Name 'sheet
        .Range("D" & LR + 1).Value = Target.Address(False, False) 'cell
        .Range("E" & LR + 1).Value = OldVal 'previous value
        .Range("F" & LR + 1).Value = Target.Value 'new value
    End With
End If
cell.Select
Application.EnableEvents = True
End Sub

 

[Damo10]

Hi,

I removed the code you highlighted and it made no difference.

I added a messagebox prompts at the New, Old & Target value changes and they are all the same as the new data entered into the cell and I put one at the end of the code and the message is displayed so it appears as though when anything is changed it is not meeting the criteria to add to the "Log" sheet

 

[VoG]

Can you give a couple of examples of values that you enter that should be different but the code disagrees.

I've tried with text, integers and decimals and it works for me.

 

[Damo10]

Hi VoG,

I have worked out a solution, the code you provided worked correctly but when it was added to the workbook with the existing sheet event change code it caused the problems. The solution was to move the sheet event code to run after the code you provided in the workbook event.

Thanks a lot for your help it is much appreciated

Regards Damian

 

[VoG]

OK, thanks for the feedback.

 

[ShieBoon]

It is just to ensure that the event code is not called needlessly when the macro writes to (changes) the Log sheet.

Hi VoG, replied quite late because i didn't visit the website throughout the weekend. Anw, the codes worked very well and thank you for the explanation too. Cheers!