VBA in Footer to show who updated and when.

[RandyD123]

I am trying to use some VBA to update my right footer to show who updated the sheet and when. It should read out as "Last Updated By %username% on Dec 07, 2023" This should change ONLY if someone has made a change to the sheet. Simply saving it with no change should not change the stamp in the right footer.

I have 2 tabs (Tab1, Tab2) that need to show when they were updated independent of each other. I am using this code but the time seems to be off a little when I run it and iit doesn't show who updated it.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim wkSht As Worksheet
    For Each wkSht In ActiveWorkbook.Worksheets
        wkSht.PageSetup.RightFooter = "&8Last Saved : " & _
            Format(ThisWorkbook.BuiltinDocumentProperties("Last Save Time"), _
            "mmm dd yyyy    hh:mm:ss")
    Next wkSht
End Sub

Any help would be most appreciated. Thank you.

 

[John_w]

Replace your code with this (in the ThisWorkbook module):

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Sh.PageSetup.RightFooter = "Last updated by " & Environ("USERNAME") & " on " & Format(Now, "Mmm dd, yyyy")
End Sub

 

[RandyD123]

Replace your code with this (in the ThisWorkbook module):

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Sh.PageSetup.RightFooter = "Last updated by " & Environ("USERNAME") & " on " & Format(Now, "Mmm dd, yyyy")
End Sub

Works perfectly. Thank you!