On cell change issue

[jtodd]

HI I have the following code

Private Sub worksheet_change(ByVal Target As Range)
    ActiveSheet.Unprotect "MS"
    If Not Intersect(Range("A:A,H:H"), Target) Is Nothing Then
        Application.EnableEvents = False
        Cells(Target.Row, Cells(Target.Row, Columns.Count).End(xlToLeft).Column + 1).Value = _
        Environ("username") & "-" & Date
    End If
    ActiveSheet.Select
     With ActiveSheet
     .Protect Password:="MS", AllowFiltering:=True, AllowSorting:=True
    End With
    Application.EnableEvents = True
End Sub

This works fine but if the user uses copy and paste for more than one cell at a time it only puts the user name in the first cell (even though the cells have changed)
Is there a way of putting the user name in all cells that have been changed ?
Hope this makes sense

 

[ouvay]

Not sure if this is going to work as I don't have data to test with, so please give me your feedback.

Private Sub worksheet2_change(ByVal Target As Range)
    ActiveSheet.Unprotect "MS"
    Dim WorkRng As Range
    Dim Rng As Range
    Set WorkRng = Intersect(Range("A:A,H:H"), Target)
    If Not WorkRng Is Nothing Then
        Application.EnableEvents = False
        For Each Rng In WorkRng.Cells
        Cells(Target.Row, Cells(Target.Row, Columns.Count).End(xlToLeft).Column + 1).Value = _
        Environ("username") & "-" & Date
        Next
    End If
    ActiveSheet.Select
     With ActiveSheet
     .Protect Password:="MS", AllowFiltering:=True, AllowSorting:=True
    End With
    Application.EnableEvents = True
End Sub

 

[jtodd]

Hi Thanks for promt reply
It sort of works , if i copy say H3:H5 and paste into H6:H9 it puts the user name in I6 ,I7,I8 .
What i want is for the user name to go into I6,i7,I8 ie next to the cell that has been changed

 

[Anthony47]

In the tested code you should replace Cell(Target.Row etc etc with Cells(Rng.Row etc etc
But with that code there is the risk you insert the user information even if you modify cells not in columns A or H

So my suggestion is to rearrange the whole code as follows:

Private Sub worksheet_change(ByVal Target As Range)
Dim Rng As Range
    Me.Unprotect "MS"
    Application.EnableEvents = False
    For Each Rng In Target
        If Not Intersect(Range("A:A,H:H"), Rng) Is Nothing Then
            Rng.Offset(0, 1000).End(xlToLeft).Offset(0, 1).Value = _
              Environ("username") & "-" & Date
        End If
    Next Rng
    Me.Protect Password:="MS", AllowFiltering:=True, AllowSorting:=True
    Application.EnableEvents = True
End Sub

 

[jtodd]

In the tested code you should replace Cell(Target.Row etc etc with Cells(Rng.Row etc etc
But with that code there is the risk you insert the user information even if you modify cells not in columns A or H

So my suggestion is to rearrange the whole code as follows:

Private Sub worksheet_change(ByVal Target As Range)
Dim Rng As Range
    Me.Unprotect "MS"
    Application.EnableEvents = False
    For Each Rng In Target
        If Not Intersect(Range("A:A,H:H"), Rng) Is Nothing Then
            Rng.Offset(0, 1000).End(xlToLeft).Offset(0, 1).Value = _
              Environ("username") & "-" & Date
        End If
    Next Rng
    Me.Protect Password:="MS", AllowFiltering:=True, AllowSorting:=True
    Application.EnableEvents = True
End Sub

Hi
Sorry but when run this code i get a debug

Private Sub worksheet_change(ByVal Target As Range)
Dim Rng As Range
Me.Unprotect "MS"
Application.EnableEvents = False
For Each Rng In Target
If Not Intersect(Range("A:A,H:H"), Rng) Is Nothing Then
Rng.Offset(0, 1000).End(xlToLeft).Offset(0, 1).Value = _
    Environ("username") & "-" & Date
End If
Next Rng
Me.Protect Password:="MS", AllowFiltering:=True, AllowSorting:=True
Application.EnableEvents = True
End Sub

 

[Jaafar Tribak]

Hi Thanks for promt reply
It sort of works , if i copy say H3:H5 and paste into H6:H9 it puts the user name in I6 ,I7,I8 .
What i want is for the user name to go into I6,i7,I8 ie next to the cell that has been changed

This may be close to what you want:

Private Sub worksheet_change(ByVal Target As Range)
    On Error GoTo errHandler:
    If Not Intersect(Range("A:A,H:H"), Target) Is Nothing Then
        If WorksheetFunction.CountA(Target) Then
            Application.EnableEvents = False
            Unprotect "MS"
            Target.Offset(, 1) = Environ("username") & "-" & Date
            Protect Password:="MS", AllowFiltering:=True, AllowSorting:=True
        End If
    End If
errHandler:
    Application.EnableEvents = True
    If Err.Number Then Err.Raise Err.Number
End Sub

 

[Anthony47]

Don't miss the message from JT, above...

Sorry but when run this code i get a debug

Which error on which line?

 

[jtodd]

Sorry Thought I had hilighted the lines

This is the line that is highlighted

 Rng.Offset(0, 1000).End(xlToLeft).Offset(0, 1).Value = _
              Environ("username") & "-" & Date

 

[Joe4]

Sorry Thought I had hilighted the lines

Note that you cannot use the formatting options on code which you use the VBA tags for.
If you want to use the formatting options, use the Rich tags instead.
I went back and changed your tags over from VBA to Rich so you can now see the formatting.

 

[Anthony47]

Does the error occours in any of yout test or just in some conditions?

Modify for testing the For Each Rng /Next Rng loop as follows:

    For Each Rng In Target
        If Not Intersect(Range("A:A,H:H"), Rng) Is Nothing Then
        On Error Resume Next
            JJ = JJ + 1
            Debug.Print JJ, Target.Address, Rng.Address
            Debug.Print "A", Rng.Offset(0, 1000).End(xlToLeft).Offset(0, 1).Address
            Debug.Print "B", Environ("username") & "-" & Date
        On Error GoTo 0
            Rng.Offset(0, 1000).End(xlToLeft).Offset(0, 1).Value = _
              Environ("username") & "-" & Date
        End If
    Next Rng

Then run a couple of test with the error and involving few cells; when the error arise, while in debug mode, open the vba Immediate window (typing Contr-g should do the job; or Menu /View /Immediate window), copy what is listed there and insert in your next message. If you wish to hide the username then replace it with "UserName"