Colourindex changes by changing cell value

[Rob Kuijpers]

Hi all,

I have a 130 column/375 row spreadsheet or so. I want the colour of a
cell to change when a specific value is entered in one of 40 different
columns. I think I have 2 options:
1. Using cond. format, is quick, but has only 3 conditions
2. Using Workbook_SheetChange with Intersect-Target-Range, is slower
but can have my 7 variables. With 40 columns in the code I get a 1004
error: Method Range of Object Global. It works fine (but slow) with 26
columns.

Is there another, preferably faster method?

This is the code I use

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
'MsgBox Target.Address
Dim myRng As Range, Number As Integer
Number = Sh.Index
Select Case Number
Case 11, 13, 15
If Target.Cells.Count > 1 Then Exit Sub

If Not Intersect(Target,
Range("H3:H374,J3:J374,N3:N374,P3374,T3:T374,V3:V374,Z3:Z374," & _
"AB3:AB374,AF3:AF374,AH3:AH374,AL3:AL374,AN3:AN374,AR3:AR374," & _
"AT3:AT374,AX3:AX374,AZ3:AZ374,BD3:BD374,BF3:BF374,BJ3:BJ374," & _
"BL3:BL374,BP3:BP374,BR3:BR374,BV3:BV374,BX3:BX374,CB3:CB374," & _
"CD3:CD374")) Is Nothing Then
'These I can't use: ,CH3:CH374,CJ3:CJ374,CN3:CN374," & _
"CP3:CP374,CT3:CT374,CV3:CV374,CZ3:CZ374,DB3B374,DF3F374," & _
"DH3H374,DL3L374,DN3N374
Set myRng = Target.Offset(0, -1).Resize(1, 2)
Select Case LCase(Target.Value)
Case Is = "v": myRng.Interior.ColorIndex = 4
Case Is = "r": myRng.Interior.ColorIndex = 33
Case Is = "z": myRng.Interior.ColorIndex = 7
Case Is = "a": myRng.Interior.ColorIndex = 45
Case Is = "d": myRng.Interior.ColorIndex = 24
Case Is = "u": myRng.Interior.ColorIndex = 36
Case Is = "*": myRng.Interior.ColorIndex = 15
Case Else
Set myRng = Target.Offset(0, -1).Resize(1, 1)
myRng.Interior.ColorIndex = xlNone
Set myRng = Target.Offset(0, 0).Resize(1, 1)
myRng.Interior.ColorIndex = 15
End Select
End If
Case Else
End Select
End Sub

TIA for any advice,
regards, Rob

 

[Trevor Shuttleworth]

Rob

try this for the checking part of the code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim CheckRange As Range
Set CheckRange =
Intersect(Range("H:H,J:J,N:N,P,T:T,V:V,Z:Z,AB:AB,AF:AF,AH:AH,AL:AL,AN:AN,A
R:AR,AT:AT,AX:AX,AZ:AZ,BD:BD,BF:BF,BJ:BJ,BL:BL,BP:BP,BR:BR,BV:BV,BX:BX,CB:CB
,CD:CD,CH3:CH374,CJ3:CJ374,CN3:CN374,CP:CP,CT:CT,CV:CV,CZ:CZ,DBB,DFF,DH:
DH,DLL,DNN"), Range("3:374"))
If Intersect(Target, CheckRange) Is Nothing Then Exit Sub
MsgBox "direct hit"
End Sub

watch for the line wrap: Set CheckRange ... ("H:H, ... Range("3:374")) is
all on one line.

Regards

Trevor

 

[Tom Ogilvy]

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
'MsgBox Target.Address
Dim myRng As Range, Number As Integer
Dim rng1 as Range, rng2 as Range
Number = Sh.Index
If Target.Cells.Count > 1 Then Exit Sub
set rng1 = Range("H3:H374,J3:J374,N3:N374,P3374,T3:T374,V3:V374,Z3:Z374,"
& _
"AB3:AB374,AF3:AF374,AH3:AH374,AL3:AL374,AN3:AN374,AR3:AR374," & _
"AT3:AT374,AX3:AX374,AZ3:AZ374,BD3:BD374,BF3:BF374,BJ3:BJ374," & _
"BL3:BL374,BP3:BP374,BR3:BR374,BV3:BV374,BX3:BX374,CB3:CB374," & _
"CD3:CD374"))
set rng2 = Range("CH3:CH374,CJ3:CJ374,CN3:CN374," & _
"CP3:CP374,CT3:CT374,CV3:CV374,CZ3:CZ374,DB3B374,DF3F374," & _
"DH3H374,DL3L374,DN3N374")
if not Intersect(Target,rng1) is nothing or not intersect(Target,rng2) is
nothing then
Select Case Number
Case 11, 13, 15
Set myRng = Target.Offset(0, -1).Resize(1, 2)
Select Case LCase(Target.Value)
Case Is = "v": myRng.Interior.ColorIndex = 4
Case Is = "r": myRng.Interior.ColorIndex = 33
Case Is = "z": myRng.Interior.ColorIndex = 7
Case Is = "a": myRng.Interior.ColorIndex = 45
Case Is = "d": myRng.Interior.ColorIndex = 24
Case Is = "u": myRng.Interior.ColorIndex = 36
Case Is = "*": myRng.Interior.ColorIndex = 15
Case Else
Set myRng = Target.Offset(0, -1).Resize(1, 1)
myRng.Interior.ColorIndex = xlNone
Set myRng = Target.Offset(0, 0).Resize(1, 1)
myRng.Interior.ColorIndex = 15
End Select
End If
End Select
End Sub

I don't think there is a faster method.

 

[Anders S]

Is there another, preferably faster method?

Maybe a bit off-topic, but faster and preferably in terms of development and
maintenance would be - IMO - to use named references instead of hardcoding the
ranges.

For example:

'-----
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim CheckRange As Range
Set CheckRange = Application.Union( _
Range("megaRange"), _
Range("megaRange2"), _
Range("megaRange3"))
If Intersect(Target, CheckRange) Is Nothing Then Exit Sub
MsgBox "OK"
End Sub
'-----

The above code responds instantaneously with the ranges in the original message
defined as names (entire columns), from H:H to DNN. The worksheet is otherwise
empty though.

Best regards,
Anders Silvén

 

[Bob Phillips]

You are right, nor is R or X. This suggest to me that there is a more
complex pattern, but not much more complex, but seeing as Rob has other
solutions I don't think I'll bother trying for it <G>

Bob

 

[Rob Kuijpers]

Thanks Trevor, your code worked fine. But is still very slow
(PIII800). Gonna have to live with that ;-(
It's funny when a value is entered by <ENTER> the calculationprocess
starts (0-100%) on the statusbar and after 4 seconds or so the change
is carried out. When I use <ENTER> 2 times (or using arrows for that
matter) after entering a value, the change is carried out immediately
(1 second). What is it waiting for the first time (showing me that it
can count from 1-100??)
Thanks again (all of you) for your answer(s), greatly appreciated.

Rob

 

[Rob Kuijpers]

Thanks Bob,

There is a pattern firstcolumn,+2,+4,+2, etc..
But I guess it won't go faster, only nicer programing and less maintenance
Appreciate it,
Rob

 

[Trevor Shuttleworth]

Rob

can't think why that would be ... unless the first time it is used the code
is compiled. But I thought it only needed to be compiled once. You could
try Debug | Compile VBAProject to see if that makes a difference.

Testing a slightly modified version of your code combined with mine, the
effect is immediate.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim myRng As Range, Number As Integer
Dim CheckRange As Range

Number = Sh.Index
Select Case Number
Case 11, 13, 15
If Target.Cells.Count > 1 Then Exit Sub

Set CheckRange =
Intersect(Range("H:H,J:J,N:N,P,T:T,V:V,Z:Z,AB:AB,AF:AF,AH:AH,AL:AL,AN:AN,A
R:AR,AT:AT,AX:AX,AZ:AZ,BD:BD,BF:BF,BJ:BJ,BL:BL,BP:BP,BR:BR,BV:BV,BX:BX,CB:CB
,CD:CD,CH:CH,CJ:CJ,CN:CN,CP:CP,CT:CT,CV:CV,CZ:CZ,DBB,DFF,DHH,DLL,DN:
DN"), _
Range("3:374"))
If Intersect(Target, CheckRange) Is Nothing Then Exit Sub

Set myRng = Target.Offset(0, -1).Resize(1, 2)
Select Case LCase(Target.Value)
Case Is = "v": myRng.Interior.ColorIndex = 4
Case Is = "r": myRng.Interior.ColorIndex = 33
Case Is = "z": myRng.Interior.ColorIndex = 7
Case Is = "a": myRng.Interior.ColorIndex = 45
Case Is = "d": myRng.Interior.ColorIndex = 24
Case Is = "u": myRng.Interior.ColorIndex = 36
Case Is = "*": myRng.Interior.ColorIndex = 15
Case Else
Target.Offset(0, -1).Resize(1, 1).Interior.ColorIndex =
xlNone
Target.Offset(0, 0).Resize(1, 1).Interior.ColorIndex = 15
End Select
Case Else
End Select
End Sub

Regards

Trevor

 

[Tom Ogilvy]

You are being misled in your observation. the second enter terminates the
calculate before it is done - so you may see a change in the cell of
interest, but other cells do not get calculated - thus the shorter time.