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!
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