worksheet_change D.McRitchie

[Guest]

I found Dave McRitchie's code that would work perfect for my post of 9/10 -
Capture date and data...
But I can't seem to modify it to allow me set as target multiple cells in
diferent locations throughout the sheet and then stamp date and record each
change on another sheet.
---------------------------
I also found the following code:

Private Sub Worksheet_Change(ByVal Target As Range)
With Sheets("sheet2")
x = .Cells(Rows.Count, "a").End(xlUp).Row + 1
If Target.Address = "$B$4" Then .Cells(x, "a") = Target
End With
End Sub
Which would work perfect if I could combine Dave's code with this one and
make it multiple target cells.

Could you please give me a hand?
As always, very grateful for any help you can give me.

I need to date certain cells as they change and copy them to another sheet.
I only find

 

[Dave Peterson]

One way:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRng As Range
Dim myCell As Range
Dim NextRow As Long

Set myRng = Me.Range("a:a,b1:c9")

If Intersect(Target, myRng, Me.UsedRange) Is Nothing Then Exit Sub

On Error GoTo errHandler:

Application.EnableEvents = False
For Each myCell In Intersect(Target, myRng, Me.UsedRange).Cells
With Worksheets("sheet2")
NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(NextRow, "A").Value = "'" & myCell.Value
.Cells(NextRow, "B").Value = myCell.Address
With .Cells(NextRow, "C")
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
End With
End With
Next myCell

errHandler:
Application.EnableEvents = True

End Sub

 

[Guest]

It's brilliant! Thanks! It works perfect!

One way:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRng As Range
Dim myCell As Range
Dim NextRow As Long

Set myRng = Me.Range("a:a,b1:c9")

If Intersect(Target, myRng, Me.UsedRange) Is Nothing Then Exit Sub

On Error GoTo errHandler:

Application.EnableEvents = False
For Each myCell In Intersect(Target, myRng, Me.UsedRange).Cells
With Worksheets("sheet2")
NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(NextRow, "A").Value = "'" & myCell.Value
.Cells(NextRow, "B").Value = myCell.Address
With .Cells(NextRow, "C")
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
End With
End With
Next myCell

errHandler:
Application.EnableEvents = True

End Sub

 

[Dave Peterson]

If you trusted the name that's in Tools|options|general:

..Cells(NextRow, "D").Value = application.username

If you still have users who go by: Valued Gateway Customer
you could use their network logon id, put this in a General module:

Option Explicit
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If lngX <> 0 Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = ""
End If
End Function

Then:

..Cells(NextRow, "E").Value = fOSUserName

(you could keep both if some of the network id's are kind of cryptic.)

 

[Guest]

Thanks! That's what I needed. I truly appreciate your help.