Checklist formula

[NoxGalleon106]

Hi,

I am working on our checklist. The current setup is that, when cell in column D is double clicked
1. It will show a check mark
2. Cell in Column E will be updated with the time when the cell was double-clicked
3. Cell in Column F will be updated with the person's UserID

The issue that I am encountering is when the file is opened as another's PC. All the userID in column F will then updated with that person's ID.

For example: Simon signs off the checklist and "Simon" is shown in column F. But then, if another person opens the excel,
the userID will be changed to his/ her ID.

I think this is because of the formula in Column F - =IF(D4<>"",GetUserName(),"")

Do you have alternative formula/DBAcode for this? The idea is to show the maker's ID and the time it was signed off.

Thank you.

 

[NoxGalleon106]

Hi,

I have the below alternative code but unsure how to incorporate with my existing code. Please help.
Thank you.

Alternative code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Column = 4 Then
ThisRow = Target.Row
If (ThisRow = 4) Then Exit Sub
Range("E" & ThisRow).Value = Now
Range("F" & ThisRow).Value = Environ("username")
Range("E:F").EntireColumn.AutoFit
End If

If Target.Column = 7 Then
ThisRow = Target.Row
If (ThisRow = 7) Then Exit Sub
Range("I" & ThisRow).Value = Now
Range("J" & ThisRow).Value = Environ("username")
Range("I:J").EntireColumn.AutoFit

End If
End Sub

Existing code:

Private Sub Worksheet_Change(ByVal target As Range)

If Intersect(target, Range("C64")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If target.Value <> Application.UserName Then
Application.EnableEvents = False
MsgBox "Hi " & Application.UserName & "!" & " Please do not sign off on behalf of others.", vbOKOnly
target.ClearContents
Else
target.Offset(0, 1) = Now()

End If


Call PDF

Application.EnableEvents = True

End Sub

 

[DanteAmor]

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("C64")) Is Nothing Then
        If Target.Value <> Application.UserName Then
            MsgBox "Hi " & Application.UserName & "!" & " Please do not sign off on behalf of others.", vbOKOnly
            Application.EnableEvents = False
            Target.ClearContents
            Application.EnableEvents = True
        Else
            Target.Offset(0, 1) = Now()
        End If
        Call PDF
    End If
    
    If Target.Column = 4 Then
        ThisRow = Target.Row
        If (ThisRow = 4) Then Exit Sub
        Range("E" & ThisRow).Value = Now
        Range("F" & ThisRow).Value = Environ("username")
        Range("E:F").EntireColumn.AutoFit
    End If


    If Target.Column = 7 Then
        ThisRow = Target.Row
        If (ThisRow = 7) Then Exit Sub
        Range("I" & ThisRow).Value = Now
        Range("J" & ThisRow).Value = Environ("username")
        Range("I:J").EntireColumn.AutoFit
    End If
End Sub