PDA

View Full Version : Solved: Help with select case



rama4672
04-18-2006, 08:10 AM
I am setting up a select case function to work on worksheet_selectionchange, I have 2 sets of vehicle registrations to use, each set has 52 vehicles, what i whant it to do is if it recognises a vehicle from one set the fill the interior color a paticular color, if it recognises from the second set the use a different color fill.
I can do this individual but it would be a lot a case statements, is there a way to put the numbers in a array and then just use the array.

I have included the code that i have got so far.
I have only put in 2 vehicles for each case if i had to put in 52 it would be a lot of typing


Option Explicit
Option Compare Text

Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng1 As Range
Dim cl As Range
Dim cdcunit As Variant
Application.ScreenUpdating = False
Set rng1 = Range("a1:a200")
'& Range("a65536").End(xlUp).Row)
rng1.Interior.ColorIndex = xlNone
'Set rng1 = rng1.SpecialCells(xlCellTypeConstants, 2)
For Each cl In rng1
Select Case cl.Value
Case Is = "abc", "def"
cl.Interior.ColorIndex = 3
Case Is = "wfy", "ghi"
cl.Interior.ColorIndex = 40


Case Else
cl.Interior.ColorIndex = 0


End Select
Next cl
Application.ScreenUpdating = True
End Sub


Thanks in advance fo any help on this

OBP
04-18-2006, 08:41 AM
You should look at either putting them in arrays or looping through the columns? to find the vehicles you want. The setting of the cell colours should be in a subroutine which you can call up with a gosub when your check routine finds the match.

Bob Phillips
04-18-2006, 02:53 PM
I can do this individual but it would be a lot a case statements, is there a way to put the numbers in a array and then just use the array.

It would, but you only have to do it once, and even if you use an array you have to type it somewhere to load in an array. Bite the bullet.

rama4672
04-18-2006, 10:42 PM
It would, but you only have to do it once, and even if you use an array you have to type it somewhere to load in an array. Bite the bullet.

Thanks for the reply's
That is what i did XLD.
This is the code that i am now using


Option Explicit
Option Compare Text

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rng1 As Range
Dim cl As Range
Dim cdcunit As Variant
Dim wiganunit As Variant

Application.ScreenUpdating = False
'wiganunit = Range("WiganUnits")
'Set cdcunit = Range("cdcunits")
Set rng1 = Range("J1:J200")
'& Range("a65536").End(xlUp).Row)
rng1.Interior.ColorIndex = xlNone
'Set rng1 = rng1.SpecialCells(xlCellTypeConstants, 2)
For Each cl In rng1
Select Case cl.Value
' These units are base fleet for CDC Skelmersadale
Case Is = "KDU", "KDV", "KDX", "KDZ", "KFA", "KFD", "KFE", "COH", "CPE", _
"CPZ", "CRF", "CRJ", "CRK", "CRU", "CRV", "CRZ", "CTE", "CTF", "CTO", _
"CTU", "CTV", "CTY", "CUK", "CUO", "CUU", "CUV", "CUW", "CUY", "CWM", "CWN", _
"CWR", "CWT", "NNO", "NNW", "NNP", "NNR", "NNT", "NNV"
cl.Interior.ColorIndex = 3

'These units are restricted mileages for CDC Skelmersdale
Case Is = "SGY", "SGZ", "SHJ", "SJU", "SJX", "SKF", "SKJ", "SKV", "SKX", "SLV"
cl.Interior.ColorIndex = 6

'These units are Wigan base fleet
Case Is = "KCE", "KCF", "KCG", "KCJ", "KCN", "KCU", "KCV", "KCX", "KCZ", "KDF", "KDJ", "KDN", "CPK", _
"CPV", "CPY", "CWO", "CSO", "CSF", "CSU", "CSV", "CSY", "CSZ", "CWP", "CTZ", "CUA", "CUC", "CUG", "CUH", "CUJ", _
"CVA", "CVE", "CVF", "CVG", "CVB", "CVC", "CVH", "HWH", "HWK", "NNU"
cl.Interior.ColorIndex = 8

'These units are restricted mileages for Wigan
Case Is = "WFY", "WGA", "WGC", "WGD", "WFZ", "OOE", "SHX", "SHZ", "SJO", "SJV", "SKD", "SGV", "SYS"
cl.Interior.ColorIndex = 40

Case Else
cl.Interior.ColorIndex = 0


End Select
Next cl
Application.ScreenUpdating = True
End Sub


This works fine on one workbook, but i have another workbook that it needs to be able to work, but the other workbook has got macro's in it that runs and puts data on each sheet, as this is a change event every time the macro's run it is taking a long time to complete as the workbook change event is trying to update aswell.

Any help with this one

TIA
Ian

mdmackillop
04-18-2006, 11:15 PM
A few thoughts,

With any change, you are checking 200 cells. Will the change not affect one cell at a time?

To prevent other change events from happening, insert Application.EnableEvents = False at the start of your code and Application.EnableEvents = True at the end of your code. Ensure that on any error, the reset to True occurs otherwise events will not trigger your code.

Your code will run whenever you change any worksheet. If this is not required, move your code to a standard module and call it from the required sheets.

The code will also run through when any cell is selected. You can limit this by checking for "valid" cells only.

If Not Intersect(Target, rng1) Is Nothing Then
DoEvents
Else
Exit Sub
End If

Regards
MD

rama4672
04-19-2006, 05:50 AM
A few thoughts,

With any change, you are checking 200 cells. Will the change not affect one cell at a time?

To prevent other change events from happening, insert Application.EnableEvents = False at the start of your code and Application.EnableEvents = True at the end of your code. Ensure that on any error, the reset to True occurs otherwise events will not trigger your code.

Your code will run whenever you change any worksheet. If this is not required, move your code to a standard module and call it from the required sheets.

The code will also run through when any cell is selected. You can limit this by checking for "valid" cells only.

If Not Intersect(Target, rng1) Is Nothing Then
DoEvents
Else
Exit Sub
End If

Regards
MD

Thanks for the reply MD, I have done as you have said and it is now working good.
The code does need to run on each sheet, but by adding

If Not Intersect(Target, rng1) Is Nothing Then
DoEvents
Else
Exit Sub
End If

It is faster.
I am going to mark this as solved.
Ok, Can some one mark this as solved, I have just tried to do it and it is telling me I can not perform that action.

Regards
Ian