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
|