Colourindex changes by changing cell value

  • Thread starter Thread starter Rob Kuijpers
  • Start date Start date
R

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,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
 
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,CV: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
 
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.
 
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
 
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
 
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
 
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
 
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,DB: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
 
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.
 
Back
Top