Change Username and Time Only When a Change is Made using VBA

[RandyD123]

What I would like my sheet to do is in cell M2 have the users name show and in cell M3 have the current time show. But I only want these cells to change IF the user enters or changes any other cell in the document. That range is B5 - M14. So if anyone changes one of those cells, then M2 and M3 only change at that point. I am using the code below which works when the workbook is opened but others need to open the workbook just to view it and I don't want M2 or M3 to change for people that will only view the document.

Private Sub Workbook_Open()
 Dim Ws As Worksheet
 Set Ws = ActiveSheet
 Ws.Range("M2") = Environ("Username")
 Ws.Range("M3") = Now
 End Sub

I had set it to work on "save only" but when someone embeds the file in an e-mail they technically don't have to save the document and in that case M2 and M3 won't change.

Thank you for any help on this.

 

[rollis13]

Use this event Workbook_SheetChange instead of your event Workbook_Open, it will now work on every sheet in your workbook at changes in range B5:M14, not only when opening for the first time the workbook. If not all the sheets are to be supervised you can add restriction. Needs to be pasted in ThisWorkbook module replacing your macro Workbook_Open.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Ws     As Worksheet
    Set Ws = ActiveSheet
    If Not Intersect(Target, Range("B5:M14")) Is Nothing Then
        Application.EnableEvents = False
        Ws.Range("M2") = Environ("Username")
        Ws.Range("M3") = Now
        Application.EnableEvents = True
    End If
End Sub

 

[RandyD123]

Use this event Workbook_SheetChange instead of your event Workbook_Open, it will now work on every sheet in your workbook at changes in range B5:M14, not only when opening for the first time the workbook. If not all the sheets are to be supervised you can add restriction. Needs to be pasted in ThisWorkbook module replacing your macro Workbook_Open.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Ws     As Worksheet
    Set Ws = ActiveSheet
    If Not Intersect(Target, Range("B5:M14")) Is Nothing Then
        Application.EnableEvents = False
        Ws.Range("M2") = Environ("Username")
        Ws.Range("M3") = Now
        Application.EnableEvents = True
    End If
End Sub

That seems to work perfectly, thank you. Not sure what you meant by "it will now work on every sheet in your workbook at changes in range B5:M14, not only when opening for the first time the workbook." In my range of B5:M14 are all drop downs that come from a hidden sheet (Data). With your code M2 and M3 don't change on open (perfect) that's what I wanted. M2 and M3 only change when someone changes something in B5:M14 (perfect) that's what I wanted.

I don't need or want this code to have any effect on the hidden "data" tab. So when you say "every sheet in your workbook", I don't need M2 or M3 to change if someone changes the data sheet. But I would like to have the Data Sheet show who last saved that sheet, within that sheet at E10. So I need these sheets to work independently of each other.

 

[RandyD123]

So I am getting an error when I try to save the sheet. The sheet is read only but when I try to do a save as I get the following error: "Run-time orror '1004': Method "Intersect" of object'_Global' failed

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Ws     As Worksheet
    Set Ws = ActiveSheet
   [COLOR=rgb(226, 80, 65)] If Not Intersect(Target, Range("B5:M14")) Is Nothing Then[/COLOR]
        Application.EnableEvents = False
        Ws.Range("M2") = Environ("Username")
        Ws.Range("M3") = Now
        Application.EnableEvents = True
    End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Sheets("Data").Range("E10") = Environ("UserName")
Sheets("Data").Range("E11") = Now
End Sub

 

[rollis13]

Add test for sheet "data" in macro Workbook_SheetChange and add the macro Workbook_BeforeSave in the same module.

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Ws     As Worksheet
    Set Ws = ActiveSheet
    If Ws.Name = "data" Then Exit Sub             '<- added
    If Not Intersect(Target, Range("B5:M14")) Is Nothing Then
        Application.EnableEvents = False
        Ws.Range("M2") = Environ("Username")
        Ws.Range("M3") = Now
        Application.EnableEvents = True
    End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.EnableEvents = False
    Worksheets("data").Range("E10") = Environ("Username")
    Application.EnableEvents = True
End Sub

 

[rollis13]

Is your sheet "data" not only as said "hidden" but maybe "locked" too ?

PS. you need to turn off Events as in my version of the macro.

 

[RandyD123]

Add test for sheet "data" in macro Workbook_SheetChange and add the macro Workbook_BeforeSave in the same module.

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Ws     As Worksheet
    Set Ws = ActiveSheet
    If Ws.Name = "data" Then Exit Sub             '<- added
    If Not Intersect(Target, Range("B5:M14")) Is Nothing Then
        Application.EnableEvents = False
        Ws.Range("M2") = Environ("Username")
        Ws.Range("M3") = Now
        Application.EnableEvents = True
    End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.EnableEvents = False
    Worksheets("data").Range("E10") = Environ("Username")
    Application.EnableEvents = True
End Sub

This code works perfectly for the Travel Orders sheet (sheet 1 of 2 in workbook). The username and or time will not change on the Travel Order sheet UNLESS a change is made in my range (B5:M14).... PERFECT. But if I save the the active sheet (Travel Orders) the Data sheet changes as well. That is not really the desired result. The Data sheet will hardly ever change but when I save or do a save as on the Travel Order sheet, I don't want the Data sheet to reflect the user or time change, unless someone actively changes the Data sheet. The Data sheet is not locked or password protected.

 

[RandyD123]

So close on this one. Just that pesky little issue above. Any additional help with this one would be most appreciated. This is what I have so far:

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Ws     As Worksheet
    Set Ws = ActiveSheet
    If Ws.Name = "Data" Then Exit Sub             '<- added
    If Not Intersect(Target, Range("B5:M14")) Is Nothing Then
        Application.EnableEvents = False
        Ws.Range("M2") = Environ("Username")
        Ws.Range("M3") = Now
        Application.EnableEvents = True
    End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.EnableEvents = False
    Worksheets("Data").Range("E10") = Environ("Username")
    Worksheets("Data").Range("E11") = Now
    Application.EnableEvents = True
End Sub

 

[rollis13]

In post #3 you said:

to have the Data Sheet show who last saved that sheet

that is different from what you stated in post #7:

I don't want the Data sheet to reflect the user or time change, unless someone actively changes the Data sheet

so we don't need an event 'Workbook_BeforeSave' but need once again the 'Workbook_SheetChange'.
Let's see if I correctly understood your request but now I'm assuming that you have no other sheets than "Travel Orders (sheet 1 of 2)" and "data" in your workbook. Leave only this macro in ThisWorkbook pane:

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Ws     As Worksheet
    Set Ws = ActiveSheet
    Application.EnableEvents = False
    If Ws.Name <> "Data" Then
        If Not Intersect(Target, Range("B5:M14")) Is Nothing Then
            Ws.Range("M2") = Environ("Username")
            Ws.Range("M3") = Now
        End If
    Else
        Ws.Range("E10") = Environ("Username")
        Ws.Range("E11") = Now
    End If
    Application.EnableEvents = True
End Sub

 

[RandyD123]

In post #3 you said:

that is different from what you stated in post #7:

so we don't need an event 'Workbook_BeforeSave' but need once again the 'Workbook_SheetChange'.
Let's see if I correctly understood your request but now I'm assuming that you have no other sheets than "Travel Orders (sheet 1 of 2)" and "data" in your workbook. Leave only this macro in ThisWorkbook pane:

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Ws     As Worksheet
    Set Ws = ActiveSheet
    Application.EnableEvents = False
    If Ws.Name <> "Data" Then
        If Not Intersect(Target, Range("B5:M14")) Is Nothing Then
            Ws.Range("M2") = Environ("Username")
            Ws.Range("M3") = Now
        End If
    Else
        Ws.Range("E10") = Environ("Username")
        Ws.Range("E11") = Now
    End If
    Application.EnableEvents = True
End Sub

I want them to work independently of each other. This is what I have now and it seems to work. Not sure if there is a way to consolidate this into something else:

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Ws     As Worksheet
    Set Ws = ActiveSheet
    If Ws.Name = "Data" Then Exit Sub             '<- added
    If Not Intersect(Target, Range("B5:M14")) Is Nothing Then
        Application.EnableEvents = False
        Ws.Range("M2") = Environ("Username")
        Ws.Range("M3") = Now
        Application.EnableEvents = True
    End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 Dim Ws As Worksheet
 Set Ws = ActiveSheet
     If Ws.Name = "Travel Orders" Then Exit Sub
 Ws.Range("E11") = Now
 Ws.Range("E10") = Environ("Username")
 End Sub