Colourindex changes by changing cell value
 

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,P3:P374,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,DB3:DB374 ,DF3:DF374," & _
"DH3:DH374,DL3:DL374,DN3:DN374
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

Colourindex changes by changing cell value
 

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: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,C V:CV,CZ:CZ,DB:DB,DF:DF,DH:
DH,DL:DL,DN:DN"), 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


"Rob Kuijpers" wrote in message
om...
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,P3:P374,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,DB3:DB374 ,DF3:DF374," & _
"DH3:DH374,DL3:DL374,DN3:DN374
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

Colourindex changes by changing cell value
 

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,P3:P374,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,DB3:DB374 ,DF3:DF374," & _
"DH3:DH374,DL3:DL374,DN3:DN374")
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.

--
Regards,
Tom Ogilvy


Rob Kuijpers wrote in message
om...
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,P3:P374,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,DB3:DB374 ,DF3:DF374," & _
"DH3:DH374,DL3:DL374,DN3:DN374
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

Colourindex changes by changing cell value
 

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 DN:DN. The worksheet is otherwise
empty though.

Best regards,
Anders Silvén

Colourindex changes by changing cell value
 

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

"Tom Ogilvy" wrote in message
...
Think you are seeing a pattern that isn't the

? Range("L:L").Column mod 2 = 0
True

but L isn't in the list or R or X . . .

although there might be a more complex pattern.

--
Regards,
Tom Ogilvy

Bob Phillips wrote in message
...
Rob,

Give this a try


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim myRng As Range, Number As Integer
Number = Sh.Index
Select Case Number
Case 1, 2, 3
With Target
If .Cells.Count 1 Then Exit Sub
If (.Row = 3 And .Row <= 364 And .Column = 8 And _
.Column Mod 2 = 0 And .Column <= 118) Then
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 With
Case Else
End Select
End Sub




--

HTH

Bob Phillips

"Rob Kuijpers" wrote in message
om...
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,P3:P374,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,DB3:DB374 ,DF3:DF374," & _
"DH3:DH374,DL3:DL374,DN3:DN374
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

Colourindex changes by changing cell value
 

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


"Trevor Shuttleworth" wrote in message ...

Dim CheckRange As Range
Set CheckRange =
Intersect(Range("H:H,J:J,N:N,P: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,D B:DB,DF:DF,DH:DH,DL:DL,DN:
DN"), Range("3:374"))
If Intersect(Target, CheckRange) Is Nothing Then Exit Sub

Regards

Trevor

Colourindex changes by changing cell value
 

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

"Bob Phillips" wrote in message ...
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

Colourindex changes by changing cell value
 

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: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,D B:DB,DF:DF,DH:DH,DL:DL,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


"Rob Kuijpers" wrote in message
om...
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


"Trevor Shuttleworth" wrote in message
...

Dim CheckRange As Range
Set CheckRange =

Intersect(Range("H:H,J:J,N:N,P: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,D B:DB,DF:DF,DH:DH,DL:DL,DN:
DN"), Range("3:374"))
If Intersect(Target, CheckRange) Is Nothing Then Exit Sub

Regards

Trevor

Colourindex changes by changing cell value
 

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.

--
Regards,
Tom Ogilvy


Rob Kuijpers wrote in message
om...
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


"Trevor Shuttleworth" wrote in message
...

Dim CheckRange As Range
Set CheckRange =

Intersect(Range("H:H,J:J,N:N,P: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,D B:DB,DF:DF,DH:DH,DL:DL,DN:
DN"), Range("3:374"))
If Intersect(Target, CheckRange) Is Nothing Then Exit Sub

Regards

Trevor