Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

More Than One Worksheet_Change Event? 2

Status
Not open for further replies.
shelby55

shelby55

Technical User
Jun 27, 2003
1,229
CA
Hi

I have a workbook where one worksheet contains data elements from a single patient chart.

With the brilliance of Skip I got the code below which compares column J to column B and highlights cell J if they are different.
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.

 
Sort by date Sort by votes
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
FAQ181-2886
 
Upvote 0 Downvote
So the original comparison between B & J is rows 5:37 and these 3comparisons are rows 40:60?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote

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,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
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,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Hey Skip

As always you rock...works perfectly!! Thanks so much[thumbsup2]
 
Upvote 0 Downvote
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?
 
Upvote 0 Downvote
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.
 
Upvote 0 Downvote
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.
 
Upvote 0 Downvote
Look at your Added code in 'is change in column.

It is not consistent with the pattern originally posted!

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
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.
 
Upvote 0 Downvote
Got it Skip...I wasn't referencing the comparison and target cells correctly in the last sections. It works now!

Thanks for your patience!!
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

remeng
  • Locked
  • Solved
Combine two working macros into one for MS Word 1
Replies
7
Views
853
strongm
strongm
huiettcm
  • Locked
  • Question
Excel UserForm Window 'Focus' Event Listener 1
Replies
14
Views
583
huiettcm
huiettcm
remeng
  • Locked
  • Question
If obsolete - deactivate all but one macro
Replies
6
Views
369
mintjulep
M
lameid
  • Locked
  • Question
Correct Outlook Event to process all messages?
Replies
3
Views
425
Andrzejek
Andrzejek
feipezi
  • Locked
  • Question
How to make a recorded Excel macro (convert a text file to a Workbook) more efficient?
Replies
11
Views
507
SkipVought
S

Part and Inventory Search

Sponsor

Back
Top