MARCO VBA: Auto rec which cell is last modified (Code only rec time/date/userid)

[harky]

Hi,

I had a code which auto update time & date on Col E
and last modified userid on col F.

Possible to rec which is the last modified cell?

A	B	C	D	E	F
abc	def	ghi	jkl	8/9/2019 5:03:51 PM	C:\Users\TOM , update Cell A, B, C,D

<tbody>
</tbody>

Private Sub Worksheet_Change(ByVal Target As Range)
' Code to put the date of the latest update following a change in the corresponding cell in column F
    Dim WorkRng As Range, roww As Long
    Dim rng As Range
    Set WorkRng = Intersect(Range("A:D"), Target)
    If Not WorkRng Is Nothing Then
        Application.EnableEvents = False
            For Each rng In WorkRng
                roww = rng.Row
                If Not rng.Value = "" Then
                    Cells(roww, "E").Value = Now
                    Cells(roww, "E").NumberFormat = "dd-mm-yyyy, hh:mm:ss"
                    Cells(roww, "F").Value = Environ$("Userprofile")
                Else
                    Cells(roww, "E").ClearContents
                    Cells(roww, "F").ClearContents
                End If
            Next
        Application.EnableEvents = True
    End If
End Sub

 

[jasonb75]

Perhaps by changing this line

Cells(roww, "F").Value = Environ$("Userprofile") [COLOR="#FF0000"]&", update Cell" & Target.Address(0, 0)[/COLOR]

 

[Fluff]

Another option

                If Not Rng.Value = "" Then
                    Cells(roww, "E").Value = Now
                    Cells(roww, "E").NumberFormat = "dd-mm-yyyy, hh:mm:ss"
                    If Cells(roww, "F").Value = "" Then
                        Cells(roww, "F").Value = Environ$("Userprofile") & ", update Cell" & Rng.Address(0, 0)
                     Else
                        Cells(roww, "F").Value = Cells(roww, "F").Value & ", " & Rng.Address(0, 0)
                     End If
                Else
                    Cells(roww, "E").ClearContents
                    Cells(roww, "F").ClearContents
                End If

 

[harky]

Thanks. this only display 1 cell...

Perhaps by changing this line

Cells(roww, "F").Value = Environ$("Userprofile") [COLOR=#FF0000]&", update Cell" & Target.Address(0, 0)[/COLOR]

 

[harky]

Thanks!!!!!!! quite close.. i think my way of tracking rec got it wrong.
i cant use it this way. LOL
The cell forever fill...... :P

C:\Users\TOM, update Cell A2, B2, C2, D2, D2, D2, D2

<tbody>
</tbody>

Another option

                If Not Rng.Value = "" Then
                    Cells(roww, "E").Value = Now
                    Cells(roww, "E").NumberFormat = "dd-mm-yyyy, hh:mm:ss"
                    If Cells(roww, "F").Value = "" Then
                        Cells(roww, "F").Value = Environ$("Userprofile") & ", update Cell" & Rng.Address(0, 0)
                     Else
                        Cells(roww, "F").Value = Cells(roww, "F").Value & ", " & Rng.Address(0, 0)
                     End If
                Else
                    Cells(roww, "E").ClearContents
                    Cells(roww, "F").ClearContents
                End If

 

[Fluff]

Maybe

                If Not Rng.Value = "" Then
                    Cells(roww, "E").Value = Now
                    Cells(roww, "E").NumberFormat = "dd-mm-yyyy, hh:mm:ss"
                    If Cells(roww, "F").Value = "" Then
                        Cells(roww, "F").Value = Environ$("Userprofile") & ", update Cell" & Rng.Address(0, 0)
                     ElseIf InStr(1, Cells(roww, "F").Value, Rng.Address(0, 0)) = 0 Then
                        Cells(roww, "F").Value = Cells(roww, "F").Value & ", " & Rng.Address(0, 0)
                     End If
                Else
                    Cells(roww, "E").ClearContents
                    Cells(roww, "F").ClearContents
                End If

 

[harky]

ah this work great. Thanks bro!

Maybe

                If Not Rng.Value = "" Then
                    Cells(roww, "E").Value = Now
                    Cells(roww, "E").NumberFormat = "dd-mm-yyyy, hh:mm:ss"
                    If Cells(roww, "F").Value = "" Then
                        Cells(roww, "F").Value = Environ$("Userprofile") & ", update Cell" & Rng.Address(0, 0)
                     ElseIf InStr(1, Cells(roww, "F").Value, Rng.Address(0, 0)) = 0 Then
                        Cells(roww, "F").Value = Cells(roww, "F").Value & ", " & Rng.Address(0, 0)
                     End If
                Else
                    Cells(roww, "E").ClearContents
                    Cells(roww, "F").ClearContents
                End If

 

[Fluff]

You're welcome & thanks for the feedback