Intersect Method with Worksheet_Change

blue · Jan 24th 2006

Hi there once again.

I hope that someone can spot my coding error. This same code worked fine last week and I'm not sure what has changed. As you can see by my probably ridiculous code below, I am trying to clear the contents of a range of cells based on the entry in another range of cells.

It is now not only clearing the range of cells that I expect but another random 3 or 4 other ranges.

As you can see, when completed I want to address 6 different cell ranges on the same worksheet and have only certain contents cleared and subsequent cells moved up. The workbook is too large to post but here is my code so far.

Oh, and if you can suggest code improvements, I would be ever so grateful. I am not a programmer - just a lowly engineer trying to wear a programming hat!

Code

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Range1 As Range
Dim Range2 As Range
Dim Range3 As Range
Dim Range4 As Range
Dim Range5 As Range
Dim Range6 As Range
Dim IntersectRange1 As Range
Dim IntersectRange2 As Range
Dim IntersectRange3 As Range
Dim IntersectRange4 As Range
Dim IntersectRange5 As Range
Dim IntersectRange6 As Range




Set Range1 = Range("J3:J16")
Set Range2 = Range("T3:T16")
Set Range3 = Range("J20:J32")
Set Range4 = Range("T20:T32")
Set Range5 = Range("J36:J50")
Set Range6 = Range("T36:T50")


Set IntersectRange1 = Intersect(Target, Range1)
Set IntersectRange2 = Intersect(Target, Range2)
Set IntersectRange3 = Intersect(Target, Range3)
Set IntersectRange4 = Intersect(Target, Range4)
Set IntersectRange5 = Intersect(Target, Range5)
Set IntersectRange6 = Intersect(Target, Range6)
'Application.ScreenUpdating = False


'If IntersectRange1 Is Nothing Then Range2Completion Commented out for debug purposes
If IntersectRange1 Is Nothing Then Exit Sub 'For debug purposes only


If IntersectRange1 = Range("J3") Then
    Application.EnableEvents = False
    Range("A3:J3").ClearContents
    Range("A4:I16").Copy
    Range("A3:I15").PasteSpecial xlPasteValues
    Range("A16:I16").ClearContents
    Range("A3").Select
    Application.EnableEvents = True
End If
If IntersectRange1 = Range("J4") Then
    Application.EnableEvents = False
    Range("A4:J4").ClearContents
    Range("A5:I16").Copy
    Range("A4:I15").PasteSpecial xlPasteValues
    Range("A16:I16").ClearContents
    Range("A3").Select
    Application.EnableEvents = True
End If
If IntersectRange1 = Range("J5") Then
    Application.EnableEvents = False
    Range("A5:J5").ClearContents
    Range("A6:I16").Copy
    Range("A5:I15").PasteSpecial xlPasteValues
    Range("A16:I16").ClearContents
    Range("A3").Select
    Application.EnableEvents = True
End If
If IntersectRange1 = Range("J6") Then
    Application.EnableEvents = False
    Range("A6:J6").ClearContents
    Range("A7:I16").Copy
    Range("A6:I15").PasteSpecial xlPasteValues
    Range("A16:I16").ClearContents
    Range("A3").Select
    Application.EnableEvents = True
End If
If IntersectRange1 = Range("J7") Then
    Application.EnableEvents = False
    Range("A7:J7").ClearContents
    Range("A8:I16").Copy
    Range("A7:I15").PasteSpecial xlPasteValues
    Range("A16:I16").ClearContents
    Range("A3").Select
    Application.EnableEvents = True
End If
If IntersectRange1 = Range("J8") Then
    Application.EnableEvents = False
    Range("A8:J8").ClearContents
    Range("A9:I16").Copy
    Range("A8:I15").PasteSpecial xlPasteValues
    Range("A16:I16").ClearContents
    Range("A3").Select
    Application.EnableEvents = True
End If
If IntersectRange1 = Range("J9") Then
    Application.EnableEvents = False
    Range("A9:J9").ClearContents
    Range("A10:I16").Copy
    Range("A9:I15").PasteSpecial xlPasteValues
    Range("A16:I16").ClearContents
    Range("A3").Select
    Application.EnableEvents = True
End If
If IntersectRange1 = Range("J10") Then
    Application.EnableEvents = False
    Range("A10:J10").ClearContents
    Range("A11:I16").Copy
    Range("A10:I15").PasteSpecial xlPasteValues
    Range("A16:I16").ClearContents
    Range("A3").Select
    Application.EnableEvents = True
End If
If IntersectRange1 = Range("J11") Then
    Application.EnableEvents = False
    Range("A11:J11").ClearContents
    Range("A12:I16").Copy
    Range("A11:I15").PasteSpecial xlPasteValues
    Range("A16:I16").ClearContents
    Range("A3").Select
    Application.EnableEvents = True
End If
If IntersectRange1 = Range("J12") Then
    Application.EnableEvents = False
    Range("A12:J12").ClearContents
    Range("A13:I16").Copy
    Range("A12:I15").PasteSpecial xlPasteValues
    Range("A16:I16").ClearContents
    Range("A3").Select
    Application.EnableEvents = True
End If
If IntersectRange1 = Range("J13") Then
    Application.EnableEvents = False
    Range("A13:J13").ClearContents
    Range("A14:I16").Copy
    Range("A13:I15").PasteSpecial xlPasteValues
    Range("A16:I16").ClearContents
    Range("A3").Select
    Application.EnableEvents = True
End If
If IntersectRange1 = Range("J14") Then
    Application.EnableEvents = False
    Range("A14:J14").ClearContents
    Range("A15:I16").Copy
    Range("A14:I15").PasteSpecial xlPasteValues
    Range("A16:I16").ClearContents
    Range("A3").Select
    Application.EnableEvents = True
End If
If IntersectRange1 = Range("J15") Then
    Application.EnableEvents = False
    Range("A15:J15").ClearContents
    Range("A16:I16").Copy
    Range("A15:I15").PasteSpecial xlPasteValues
    Range("A16:I16").ClearContents
    Range("A3").Select
    Application.EnableEvents = True
End If
Application.ScreenUpdating = True
End Sub

Display More

**norie** · Jan 24th 2006

Re: Intersect Method with Worksheet_Change

Is this all the code?

Why are you only looking at IntersectRange1?

Code

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Range1 As Range
    Dim Range2 As Range
    Dim Range3 As Range
    Dim Range4 As Range
    Dim Range5 As Range
    Dim Range6 As Range
    Dim IntersectRange1 As Range
    Dim IntersectRange2 As Range
    Dim IntersectRange3 As Range
    Dim IntersectRange4 As Range
    Dim IntersectRange5 As Range
    Dim IntersectRange6 As Range
    Dim lRow As Long
     
    Set Range1 = Range("J3:J16")
    Set Range2 = Range("T3:T16")
    Set Range3 = Range("J20:J32")
    Set Range4 = Range("T20:T32")
    Set Range5 = Range("J36:J50")
    Set Range6 = Range("T36:T50")
     
    Set IntersectRange1 = Intersect(Target, Range1)
    Set IntersectRange2 = Intersect(Target, Range2)
    Set IntersectRange3 = Intersect(Target, Range3)
    Set IntersectRange4 = Intersect(Target, Range4)
    Set IntersectRange5 = Intersect(Target, Range5)
    Set IntersectRange6 = Intersect(Target, Range6)
     'Application.ScreenUpdating = False
     
     'If IntersectRange1 Is Nothing Then Range2Completion Commented out for debug purposes
    If IntersectRange1 Is Nothing Then Exit Sub 'For debug purposes only
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    lRow = IntersectRange1.Row
    Range("A" & lRow & ":J" & lRow).ClearContents
    Range("A" & lRow + 1 & ":I16").Copy
    Range("A" * lRow & ":I15").PasteSpecial xlPasteValues
    Range("A16:I16").ClearContents
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub

Display More

Bob Phillips · Jan 24th 2006

Re: Intersect Method with Worksheet_Change

MY guess is that perhaps more than one cell is being changed, and so more than one If condition gets invoked.

Have you stepped through it?

blue · Jan 24th 2006

Re: Intersect Method with Worksheet_Change

I am only looking at IntersectRange1 to start with. As soon as I am able to debug that, then I will add the rest of the Intersect Ranges.

And, yes, I understand that more than one cell is getting changed but in trying to debug, I have only changed a single cell but more than one is being triggered.

Stepping thru is difficult when it's a workbook_change event. Or at least I haven't figured out how to step through an event.

Thanks for all your help (and continued help?)

**norie** · Jan 24th 2006

Re: Intersect Method with Worksheet_Change

To step through just put a breakpoint (F9) somewhere.

To check if only one cell has been changed.

Code

If Target.Count>1 Then Exit Sub

By the way did you try the code I posted?

blue · Jan 24th 2006

Re: Intersect Method with Worksheet_Change

Yes, I just did, Norie and I got a type mismatch at line:

Code

Range("A" * lRow & ":I15").PasteSpecial xlPasteValues

Thanks,

Sue

**norie** · Jan 24th 2006

Re: Intersect Method with Worksheet_Change

That's just a typo.:oops:

Code

Range("A" & lRow & ":I15").PasteSpecial xlPasteValues

blue · Jan 24th 2006

Re: Intersect Method with Worksheet_Change

Gee, Norie, you think I could have spotted that for myself! Duh! Anyway, by adding the

Code

If Target.Count>1 Then Exit Sub

the macro exits even though I am adding an "x" in only one of the intersect cells so it must be looping somewhere even with the

Code

Application.EnableEvents = False

statement.

Thanks so much for your help!

**norie** · Jan 24th 2006

Re: Intersect Method with Worksheet_Change

You don't have merged cells do you?

Can you attach a sample workbook, perhaps just for the first range?

blue · Jan 24th 2006

Re: Intersect Method with Worksheet_Change

Sure, I'll cut and paste the first portion and upload it.

Hope this works and thanks a million!

**norie** · Jan 24th 2006

Re: Intersect Method with Worksheet_Change

When I paste the code into the worksheet module it appears to work.

It clears the row I enter a value in column J and then moves the other rows up.

Is that what it's meant to do?

blue · Jan 24th 2006

Re: Intersect Method with Worksheet_Change

Exactly! So I wonder what's up with that? Did you have the

Code

If Target.Count>1 Then Exit Sub

included when you ran it? I guess that doesn't make any difference since I just commented that out and now it doesn't run at all.

I just have no idea what is going on right now. I have the following:

Code

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Range1 As Range
Dim Range2 As Range
Dim Range3 As Range
Dim Range4 As Range
Dim Range5 As Range
Dim Range6 As Range
Dim IntersectRange1 As Range
Dim IntersectRange2 As Range
Dim IntersectRange3 As Range
Dim IntersectRange4 As Range
Dim IntersectRange5 As Range
Dim IntersectRange6 As Range




Set Range1 = Range("J3:J16")
Set Range2 = Range("T3:T16")
Set Range3 = Range("J20:J32")
Set Range4 = Range("T20:T32")
Set Range5 = Range("J36:J50")
Set Range6 = Range("T36:T50")


Set IntersectRange1 = Intersect(Target, Range1)
Set IntersectRange2 = Intersect(Target, Range2)
Set IntersectRange3 = Intersect(Target, Range3)
Set IntersectRange4 = Intersect(Target, Range4)
Set IntersectRange5 = Intersect(Target, Range5)
Set IntersectRange6 = Intersect(Target, Range6)


If IntersectRange1 Is Nothing Then Exit Sub 'For debug purposes only
If Target.Count > 1 Then Exit Sub


    Application.ScreenUpdating = False
    Application.EnableEvents = False
     
    lRow = IntersectRange1.Row
    Range("A" & lRow & ":J" & lRow).ClearContents
    Range("A" & lRow + 1 & ":I16").Copy
    Range("A" & lRow & ":I15").PasteSpecial xlPasteValues
    Range("A16:I16").ClearContents
     
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Display More

And nothing is happening. I cut and pasted your code and made no changes except for the typo. I'm confused (to say the least).

Thanks,

Bob Phillips · Jan 24th 2006

Re: Intersect Method with Worksheet_Change

You are probably firing off cascaded events when you change other cells, and you test the intersect wrongly.

This should do what you want.

[vba]
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Range1 As Range
Dim Range2 As Range
Dim Range3 As Range
Dim Range4 As Range
Dim Range5 As Range
Dim Range6 As Range

On Error GoTo ws_exit
Application.EnableEvents = False

Set Range1 = Range("J3:J16")
Set Range2 = Range("T3:T16")
Set Range3 = Range("J20:J32")
Set Range4 = Range("T20:T32")
Set Range5 = Range("J36:J50")
Set Range6 = Range("T36:T50")

If Not Intersect(Range1, Target) Is Nothing Then
Application.EnableEvents = False
Range("A" & Target.Row).Resize(, 10).ClearContents
Range("A" & Target.Row & ":I16").Copy
Range("A" & Target.Row & ":I15").PasteSpecial xlPasteValues
Range("A16:I16").ClearContents
Range("A3").Select
Application.EnableEvents = True
End If

ws_exit:
Application.EnableEvents = True
End Sub
[/vba]

blue · Jan 24th 2006

Re: Intersect Method with Worksheet_Change

I commented out all my code, cut and pasted yours in and nothing is happening. I don't get any errors but nothing happens on my worksheet either.

Thanks so much for your help!

**norie** · Jan 24th 2006

Re: Intersect Method with Worksheet_Change

Blue

Where is the code located?

It should be in the worksheet module which it's supposed to work on.

When I used it I did have the Count check.

Perhaps you've not turned events back on at some point when debugging?

blue · Jan 24th 2006

Re: Intersect Method with Worksheet_Change

Ok, figured out one thing that was wrong. Somewhere along the line

Code

application.enableevents = true

did not happen. When I manually added that, at least something happened. The row I wanted cleared was cleared but the subsequent rows did not move up one row so now I have the worksheet with a blank row in the middle of the range.

Bob Phillips · Jan 24th 2006

Re: Intersect Method with Worksheet_Change

Missed a 1

[vba]
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Range1 As Range
Dim Range2 As Range
Dim Range3 As Range
Dim Range4 As Range
Dim Range5 As Range
Dim Range6 As Range

On Error GoTo ws_exit
Application.EnableEvents = False

Set Range1 = Range("J3:J16")
Set Range2 = Range("T3:T16")
Set Range3 = Range("J20:J32")
Set Range4 = Range("T20:T32")
Set Range5 = Range("J36:J50")
Set Range6 = Range("T36:T50")

If Not Intersect(Range1, Target) Is Nothing Then
Application.EnableEvents = False
Range("A" & Target.Row).Resize(, 10).ClearContents
Range("A" & Target.Row + 1 & ":I16").Copy
Range("A" & Target.Row & ":I15").PasteSpecial xlPasteValues
Range("A16:I16").ClearContents
Range("A3").Select
Application.EnableEvents = True
End If

ws_exit:
Application.EnableEvents = True
End Sub
[/vba]

blue · Jan 24th 2006

Re: Intersect Method with Worksheet_Change

That did it! Thanks so much to the both of you! Now I think I can carry this on following the logic and complete the assignment. Bless you all!

blue · Jan 24th 2006

Re: Intersect Method with Worksheet_Change

Ok, all is working with the exception of range 6 which hangs up just before the paste special and I have checked it and checked it again and again and can't find anything different from the preceeding code. Here it is in it's new entirety thanks to you guys. Now just the final error and I will leave you all alone for a while with great appreciation!

Code

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Range1 As Range
    Dim Range2 As Range
    Dim Range3 As Range
    Dim Range4 As Range
    Dim Range5 As Range
    Dim Range6 As Range
     
    On Error GoTo ws_exit
    Application.EnableEvents = False
     
    Set Range1 = Range("J3:J16")
    Set Range2 = Range("T3:T16")
    Set Range3 = Range("J20:J32")
    Set Range4 = Range("T20:T32")
    Set Range5 = Range("J36:J50")
    Set Range6 = Range("T36:T50")
     
   If Not Intersect(Range1, Target) Is Nothing Then
        Application.EnableEvents = False
        Range("A" & Target.Row).Resize(, 10).ClearContents
        Range("A" & Target.Row + 1 & ":I16").Copy
        Range("A" & Target.Row & ":I15").PasteSpecial xlPasteValues
        Range("A16:I16").ClearContents
        Range("A3").Select
        Application.EnableEvents = True
    End If
    
    If Not Intersect(Range2, Target) Is Nothing Then
        Application.EnableEvents = False
        Range("K" & Target.Row).Resize(, 10).ClearContents
        Range("K" & Target.Row + 1 & ":S16").Copy
        Range("K" & Target.Row & ":S15").PasteSpecial xlPasteValues
        Range("K16:T16").ClearContents
        Range("K3").Select
        Application.EnableEvents = True
    End If
    
    If Not Intersect(Range3, Target) Is Nothing Then
        Application.EnableEvents = False
        Range("A" & Target.Row).Resize(, 10).ClearContents
        Range("A" & Target.Row + 1 & ":I32").Copy
        Range("A" & Target.Row & ":I31").PasteSpecial xlPasteValues
        Range("A32:J32").ClearContents
        Range("A20").Select
        Application.EnableEvents = True
    End If
    
    If Not Intersect(Range4, Target) Is Nothing Then
        Application.EnableEvents = False
        Range("K" & Target.Row).Resize(, 10).ClearContents
        Range("K" & Target.Row + 1 & ":S32").Copy
        Range("K" & Target.Row & ":S31").PasteSpecial xlPasteValues
        Range("K32:T32").ClearContents
        Range("K20").Select
        Application.EnableEvents = True
    End If


    If Not Intersect(Range5, Target) Is Nothing Then
        Application.EnableEvents = False
        Range("A" & Target.Row).Resize(, 10).ClearContents
        Range("A" & Target.Row + 1 & ":I50").Copy
        Range("A" & Target.Row & ":I49").PasteSpecial xlPasteValues
        Range("A50:J50").ClearContents
        Range("A36").Select
        Application.EnableEvents = True
    End If
    
    If Not Intersect(Range6, Target) Is Nothing Then
        Application.EnableEvents = False
        Range("K" & Target.Row).Resize(, 10).ClearContents
        Range("K" & Target.Row + 1 & ":S50").Copy
        Range("K" & Target.Row & ":S49").PasteSpecial xlPasteValues
        Range("K50:T50").ClearContents
        Range("K36").Select
        Application.EnableEvents = True
    End If






     
ws_exit:
    Application.EnableEvents = True
End Sub

Display More

Bob Phillips · Jan 24th 2006

Re: Intersect Method with Worksheet_Change

I can't replicate it. Can you post the workbook that fails?

Intersect Method with Worksheet_Change

Participate now!

Share

Users Viewing This Thread