GomaPile
Active Member
- Joined
- Jul 24, 2006
- Messages
- 334
- Office Version
- 365
- Platform
- Windows
Hello All,
Firstly the VBA below we didn't write this ourselves, it was found on Google forums. However it works perfectly for our department (Hospital) when rostering staff each fortnightly. It writes comments what you typed in that cell... your username | date & timestamps BUT what we would like to see happen also please.. If one of our Shift Coordinators accidentally deletes data, we would like the VBA to record who actually removed the info, and put back what was removed.
I'm not very good at writing VBA coding myself, is there someone out there who can help us to add a bit more VBA, if something was deleted by mistake....
Gary
Firstly the VBA below we didn't write this ourselves, it was found on Google forums. However it works perfectly for our department (Hospital) when rostering staff each fortnightly. It writes comments what you typed in that cell... your username | date & timestamps BUT what we would like to see happen also please.. If one of our Shift Coordinators accidentally deletes data, we would like the VBA to record who actually removed the info, and put back what was removed.
I'm not very good at writing VBA coding myself, is there someone out there who can help us to add a bit more VBA, if something was deleted by mistake....
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrHandler
Application.EnableEvents = False
Application.ScreenUpdating = False
'*** Disable this macro ***
'Call unProtectSheet
If Target.Cells.Count = 1 Then
If Len(Target.Formula) > 0 Then
'If a comment already exists, add a carriage return, username and timestamp to the current comment value.
If Not Target.Comment Is Nothing Then
With Target.Comment
MyString = Environ("USERNAME") & " " & Format(Now(), "ddd dd mmm yy hh:mm")
.Text Text:=Target.Comment.Text & Chr(10) & _
Environ("USERNAME") & " " & Format(Now(), "dd/mm/yy hh:mm:ss") & " " & Target.Value & Chr(10)
'Calculate the position of the LAST occurrence of the UserName string
MyPosition = InStrRev(Target.Comment.Text, Environ("USERNAME"))
With .Shape.TextFrame
.Characters(1, .Characters.Count).Font.Bold = False 'make the whole comment non-bold
.Characters(MyPosition, Len(Environ("USERNAME"))).Font.Bold = True
.AutoSize = True
End With
End With
'If there is no comment yet, create one and add username and timestamp
Else
With Target
.AddComment
With .Comment
.Shape.AutoShapeType = msoShapeRoundedRectangle
.Text Text:=Environ("USERNAME") & " " & Format(Now(), "dd/mm/yy hh:mm:ss") & " " & Target.Value & Chr(10)
With .Shape.TextFrame
.Characters(1, Len(Environ("USERNAME"))).Font.Bold = True
.AutoSize = True
End With
End With
End With
End If
End If
End If
'*** Disable this macro ***
'Call sbProtectSheetColour
ErrHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Gary