Event watch range not working with paste

    Problem:
    The following code works great as long as a user enters data manually into (1) cell at a time. If data is copied from multiple cells, and copied to multiple watch cells, the code does not work.


    Any ideas?


    Thanks,
    Dan[vba]Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim rngtest As Range
    Set rngtest = Range("B8:B13,F8:F11,F13:F15,B54:B57")
    If Not Application.Intersect(Target, rngtest) Is Nothing Then
    ActiveSheet.Unprotect
    With Target
    If .Value = Worksheets("Check-Output Charts").Range(.Address) Then
    .Font.ColorIndex = 5
    .Interior.ColorIndex = xlColorIndexNone
    .Interior.Pattern = xlPatternNone
    Else
    .Font.ColorIndex = 2
    .Interior.ColorIndex = 3
    .Interior.Pattern = xlSolid
    Sheets("working data").Select
    ActiveSheet.Unprotect
    Sheets("working data").Range("A3:A6").Font.ColorIndex = 2
    With Sheets("working data").Range("A3:A6").Interior
    .ColorIndex = 3
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    End With
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("output charts").Select
    End If
    End With
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    End If
    End Sub[/vba]

    Re: Experts, Event watch range not working with paste


    Hi,


    It's hard to tell exactly what you want to do with this code in isolation.
    But the problem is the following code will not work if Target is more than 1 cell.

    Code
    With Target
If .Value = Worksheets("Check-Output Charts").Range(.Address) Then


    You can use Target.cells(1).value to reference the 1st cell. Same for .Address.
    If you need to access the others you will need to include a loop of some sort.

    [h4]Cheers
    Andy    [/h4]

    Re: Experts, Event watch range not working with paste


    Here is similiar code I use in another spreadsheet, with the same problem. This is a bit nore direct, and less cumbersome. Can you expand upon the loop idea?


    Thanks again!
    Dan[vba]
    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim rngtest As Range
    Set rngtest = Range("B24:BJ25")
    If Not Application.Intersect(Target, rngtest) Is Nothing Then
    ActiveSheet.Unprotect
    With Target
    If .Value = Worksheets("Check-Working Data").Range(.Address) Then
    .Font.ColorIndex = 5
    .Interior.ColorIndex = xlColorIndexNone
    .Interior.Pattern = xlPatternNone
    Else
    .Font.ColorIndex = 2
    .Interior.ColorIndex = 3
    .Interior.Pattern = xlSolid
    Range("A3:A6").Font.ColorIndex = 2
    With Range("A3:A6").Interior
    .ColorIndex = 3
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    End With
    End If
    End With
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    End If
    End Sub[/vba]

    Re: Event watch range not working with paste


    What I am trying to do is watch cells B8:B13,F8:F11,F13:F15,B54:B57 for change. If a cell in range of B8:B13,F8:F11,F13:F15,B54:B57 changes value,(currently my code looks to another page for cell comparison) from user manipulation, Range("A3:A6") are then highlighted and color changed to RED.


    Thanks again for any input.
    I am still rather new to VBA.

    Re: Event watch range not working with paste


    Hello,


    I'm not exactly tieing your code to your description, but try something like the following:


    [vba]
    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim myRng As Range, cl As Range, tstVal As String
    If Intersect(Target, Me.Range("B8:B13,F8:F11,F13:F15,B54:B57")) Is Nothing Then _
    Exit Sub
    Me.Unprotect
    Set myRng = Intersect(Target, Me.Range("B8:B13,F8:F11,F13:F15,B54:B57"))
    Let tstVal = Worksheets("Check-Working Data").Range("a1").Value
    Application.ScreenUpdating = False
    For Each cl In myRng
    With cl
    If .Value = tstVal Then
    .Font.ColorIndex = 5
    .Interior.ColorIndex = xlColorIndexNone
    .Interior.Pattern = xlPatternNone
    Else
    .Font.ColorIndex = 2
    .Interior.ColorIndex = 3
    .Interior.Pattern = xlSolid
    End If
    End With


    Next
    Application.ScreenUpdating = True
    Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    End Sub[/vba]
    The idea is to grab the Intersect from your target and the contingent range and loop through it.


    Edit: Code tags are modifying my spacing to an extent that I don't like, see the attached text file for my original code.

    Re: Event watch range not working with paste


    Thank you for the input. I really appreciate it. I am working with it now, and will post back.

    Re: Event watch range not working with paste


    I am still having problems when I select multiple cells to paste into watched cells.


    I will get an error when trying to paste the the copied cells. (See attachment jpg) "Unable to set the ColorIndex property of the Font class"


    Here is the latest code I am using. Thanks for the input NateO.


    Thanks for the help, I think i am almost there.


    [vba]
    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim myRng As Range, cl As Range, tstVal As String
    If Intersect(Target, Me.Range("B28:BJ29")) Is Nothing Then _
    Exit Sub
    Me.Unprotect
    Set myRng = Intersect(Target, Me.Range("B28:BJ29"))
    Let tstVal = Worksheets("Check-Working Data").Range("a1").Value
    Application.ScreenUpdating = False
    For Each cl In myRng
    With cl
    If .Value = tstVal Then
    .Font.ColorIndex = 5
    .Interior.ColorIndex = xlColorIndexNone
    .Interior.Pattern = xlPatternNone
    Else
    .Font.ColorIndex = 2
    .Interior.ColorIndex = 3
    .Interior.Pattern = xlSolid
    Sheets("working data").Select
    ActiveSheet.Unprotect
    Sheets("working data").Range("A3:A6").Font.ColorIndex = 2
    With Sheets("working data").Range("A3:A6").Interior
    .ColorIndex = 3
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    End With
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("working data").Select
    End If
    End With

    Next
    Application.ScreenUpdating = True
    Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    End Sub
    [/vba]

    Re: Event watch range not working with paste


    Hmm, I am attaching my spredsheet, maybe this will help determine the problem.


    Thanks again for the help.


    Select cells B24:D24, then try to copy them to E24. only E24 will change to red, F24 & G24 do not. I had to modifiy the code to resume next on error because the code would error out with the error code descibed in the previous message.


    NOTE:Sheets("Check-Working Data").Visible = False

    Re: Event watch range not working with paste


    You should have taken notice of the error rather than simply suppress it ;)
    The reason the first cell works and the others fail is that after you do the formatting you protect the sheet. Subsequent passes though the loop fail as the sheets protected.
    Comment out the protection line within the loop and just lock stuff down when you exit.

    [h4]Cheers
    Andy    [/h4]

    Re: Event watch range not working with paste


    That was it! I did not understand the error message before. Thank you so much to NateO and Andy Pope!


    This is exactly what I was overlooking. I am still very new to this VBA stuff, and I appreciate it greatly.

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!

Register Yourself Login