INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Member Login

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips now!

Talk With Other Members
Be Notified Of Responses
To Your Posts
Keyword Search
One-Click Access To Your
Favorite Forums
Automated Signatures
On Your Posts
Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

LINK TO THIS FORUM!

Tek-Tips LinkedIn^® Group

Join our
LinkedIn^® Group!

Hook up with past and present colleagues and classmates quickly.

Partner With Us!

"Best Of Breed" Forums Add Stickiness To Your Site

(Download This Button Today!)

Feedback

"...Thanks a lot Mate! I can't tell you how many times your site has saved my "rear". hehe..."

More...

Geography

Where in the world do Tek-Tips members come from?

Click Here To Find Out!

Tek-Tips Shirts!

Get your
Tek-Tips Forums
SWAG here!

Home > Forums > Programmers > Languages > VBA Visual Basic for Applications (Microsoft) Forum

More Than One Worksheet_Change Event?(2)

CODE

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim t As Range, rng As Range
    
    Set rng = Intersect(Rows("5:37"), Range([b1], [j1]).EntireColumn)
  
    Me.Unprotect
    Me.Cells.Locked = False
    
    For Each t In Target
        With t
        
        'is change in column J?
            If Not Intersect(t, rng, Cells(1, "J").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "B").Value Then
                    .Interior.Color = 49407
                  Else
                    .Interior.ColorIndex = xlColorIndexNone

                End If
            End If
        End With
    Next
        Set rng = Nothing
        
    Me.Range("A1:A79,C5:H38,F40:H61,I5:I79,K5:P38,N40:P61,Q5:Q79").Locked = True
    Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    
End Sub

However, now I have other columns I'd like to compare:
B40:B60 compared to J40:J60
C40:C60 compared to K40:K60
D40:D60 compared to L40:L60

How can I add these onto the current code OR can I have more than one worksheet_change event in the same worksheet?

Thanks.

PHV (MIS)

27 Jul 12 21:12

CODE

...
            If Not Intersect(t, rng, Cells(1, "J").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "B").Value Then
                    .Interior.Color = 49407
                  Else
                    .Interior.ColorIndex = xlColorIndexNone
                End If
            End If
            If Not Intersect(t, rng, Cells(1, "K").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "C").Value Then
                    .Interior.Color = 49407
                  Else
                    .Interior.ColorIndex = xlColorIndexNone
                End If
            End If
            If Not Intersect(t, rng, Cells(1, "L").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "D").Value Then
                    .Interior.Color = 49407
                  Else
                    .Interior.ColorIndex = xlColorIndexNone
                End If
            End If
...

Hope This Helps, PH.
FAQ219-2884: How Do I Get Great Answers To my Tek-Tips Questions?
FAQ181-2886: How can I maximize my chances of getting an answer?

SkipVought (Programmer)

27 Jul 12 21:38

So the original comparison between B & J is rows 5:37 and these 3comparisons are rows 40:60?

Skip,
_{Just traded in my old subtlety...

for a NUANCE!}

SkipVought (Programmer)

27 Jul 12 21:47

the rng object must also be set

CODE

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim t As Range, rng As Range
    
    Set rng = Intersect( _
        Union(Rows("5:37"), Range([b1], [j1]).EntireColumn), _
        Union(Rows("40:60"), Range([b1], [j1]).EntireColumn), _
        Union(Rows("40:60"), Range([c1], [k1]).EntireColumn), _
        Union(Rows("40:60"), Range([d1], [l1]).EntireColumn))
  
    Me.Unprotect
    Me.Cells.Locked = False
    
    For Each t In Target
        With t
        
        'is change in column J?
            If Not Intersect(t, rng, Cells(1, "J").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "B").Value Then
                    .Interior.Color = 49407
                  Else
                    .Interior.ColorIndex = xlColorIndexNone
                End If
            End If
            If Not Intersect(t, rng, Cells(1, "K").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "C").Value Then
                    .Interior.Color = 49407
                  Else
                    .Interior.ColorIndex = xlColorIndexNone
                End If
            End If
            If Not Intersect(t, rng, Cells(1, "L").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "D").Value Then
                    .Interior.Color = 49407
                  Else
                    .Interior.ColorIndex = xlColorIndexNone
                End If
            End If
        End With
    Next
        Set rng = Nothing
        
    Me.Range("A1:A79,C5:H38,F40:H61,I5:I79,K5:P38,N40:P61,Q5:Q79").Locked = True
    Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    
End Sub

Skip,
_{Just traded in my old subtlety...

for a NUANCE!}

SkipVought (Programmer)

27 Jul 12 22:05

sorry

CODE

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim t As Range, rng As Range
    
    Set rng = Union( _
        Intersect(Rows("5:37"), Range([b1], [j1]).EntireColumn), _
        Intersect(Rows("40:60"), Range([b1], [l1]).EntireColumn))
  
'    Me.Unprotect
'    Me.Cells.Locked = False
    
    For Each t In Target
        With t
        
        'is change in column J?
            If Not Intersect(t, rng, Cells(1, "J").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "B").Value Then
                    .Interior.Color = 49407
                  Else
                    .Interior.ColorIndex = xlColorIndexNone
                End If
            End If
            If Not Intersect(t, rng, Cells(1, "K").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "C").Value Then
                    .Interior.Color = 49407
                  Else
                    .Interior.ColorIndex = xlColorIndexNone
                End If
            End If
            If Not Intersect(t, rng, Cells(1, "L").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "D").Value Then
                    .Interior.Color = 49407
                  Else
                    .Interior.ColorIndex = xlColorIndexNone
                End If
            End If
        End With
    Next
        Set rng = Nothing
        
'    Me.Range("A1:A79,C5:H38,F40:H61,I5:I79,K5:P38,N40:P61,Q5:Q79").Locked = True
'    Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    
End Sub

Skip,
_{Just traded in my old subtlety...

for a NUANCE!}

shelby55 (TechnicalUser)

27 Jul 12 22:34

Hey Skip

As always you rock...works perfectly!! Thanks so much thumbsup2

shelby55 (TechnicalUser)

27 Jul 12 23:03

Hi

I apologize PHV, I didn't see your post until now. Thanks very much. Skip, there seems to be a problem with what you posted because it's correctly comparing and colouring some cells but not all. For instance, it colours for changes in J and K but not L.

Because it still colours in if B is blank but J isn't or vice versa, I know it isn't because L doesn't have any data in B (but J does).

Any ideas?

shelby55 (TechnicalUser)

27 Jul 12 23:33

Hey...I shouldn't be working so late because I'm not thinking...found the problem with the range not showing up. It is working fine...thanks very much.

shelby55 (TechnicalUser)

28 Jul 12 14:36

Hi

Me again....I wanted to expand to compare more columns.

So the first part works comparing J5:J37 to B5:B37. The second part works comparing:
J40:J60 to B40:B60
K40:K60 to C40:C60
L40:L60 to D40:D60
M40:M60 to E40:E60

The third part is comparing:
J63:J79 to B63:B79
K63:K79 to C63:C79
L63:L79 to D63:D79
M63:M79 to E63:E79
N63:N79 to F63:F79
O63:O79 to G63:G79
P63:P79 to H63:H79

So I thought I could just add to the union statement and add as Skip did to get the comparison but it's not working. No colour changes occur in N, O or P when they don't match F, G, and H. Also, for some reason, at cell F66, the cell is showing up as being yellow but since the code isn't supposed to be adding colour to those columns, not sure why it is showing up.

Below is my amended but not working code:

CODE

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim t As Range, rng As Range
    
    Set rng = Union( _
        Intersect(Rows("5:37"), Range([b1], [j1]).EntireColumn), _
        Intersect(Rows("40:60"), Range([b1], [m1]).EntireColumn), _
        Intersect(Rows("63:79"), Range([b1], [p1]).EntireColumn))
        
        
    Me.Unprotect
    Me.Cells.Locked = False
    
    For Each t In Target
        With t
        
        'is change in column J?
            If Not Intersect(t, rng, Cells(1, "J").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "B").Value Then
                    .Interior.Color = 49407
                  Else
                    .Interior.ColorIndex = xlColorIndexNone
                End If
            End If
        
       'is change in column K?
        If Not Intersect(t, rng, Cells(1, "K").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "C").Value Then
                    .Interior.Color = 49407
                  Else
                    .Interior.ColorIndex = xlColorIndexNone
                End If
            End If
         'is change in column L?
            If Not Intersect(t, rng, Cells(1, "L").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "D").Value Then
                    .Interior.Color = 49407
                  Else
                    .Interior.ColorIndex = xlColorIndexNone
                End If
            End If
            
        'is change in column M?
        If Not Intersect(t, rng, Cells(1, "M").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "E").Value Then
                    .Interior.Color = 49407
                  Else
                    .Interior.ColorIndex = xlColorIndexNone
                End If
            End If
        
       'is change in column N?
        If Not Intersect(t, rng, Cells(1, "F").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "N").Value Then
                    .Interior.Color = 49407
                  Else
                    .Interior.ColorIndex = xlColorIndexNone
                End If
            End If
        
        'is change in column O?
        If Not Intersect(t, rng, Cells(1, "G").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "O").Value Then
                    .Interior.Color = 49407
                  Else
                    .Interior.ColorIndex = xlColorIndexNone
                End If
            End If
        
        'is change in column P?
            If Not Intersect(t, rng, Cells(1, "H").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "P").Value Then
                    .Interior.Color = 49407
                  Else
                    .Interior.ColorIndex = xlColorIndexNone
                End If
            End If
               
        End With
    Next
        Set rng = Nothing
        
    'Me.Range("A1:A79,C5:H38,F40:H61,I5:I79,K5:P38,N40:P61,Q5:Q79").Locked = True
    'Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    
End Sub

Any assistance greatly appreciated - thanks.

SkipVought (Programmer)

28 Jul 12 16:21

Look at your Added code in 'is change in column.

It is not consistent with the pattern originally posted!

Skip,
_{Just traded in my old subtlety...

for a NUANCE!}

shelby55 (TechnicalUser)

28 Jul 12 17:33

Sorry Skip but I don't see what your talking about...and now I get a compile error of "invalid or unqualified reference" at the line .Interior.Color = 49407 for the the "is change in colomn O" section.

As for consistency, I just took what you posted, copied each section and added the new ones and added to the Union rng so I'm sorry but I'm not seeing it.

shelby55 (TechnicalUser)

28 Jul 12 17:49

Got it Skip...I wasn't referencing the comparison and target cells correctly in the last sections. It works now!

Thanks for your patience!!

SkipVought (Programmer)

28 Jul 12 18:06

Skip,
_{Just traded in my old subtlety...

for a NUANCE!}

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Back To Forum

Back To VBA Visual Basic for Applications (Microsoft)

Member Login

Come Join Us!

LINK TO THIS FORUM!

Tek-Tips LinkedIn® Group

Partner With Us!

Feedback

Geography

Tek-Tips Shirts!

More Than One Worksheet_Change Event?(2)

CODE

CODE

CODE

CODE

CODE

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Back To Forum

Join Tek-Tips® Today!

Tek-Tips LinkedIn^® Group

Join Tek-Tips^® Today!