Solved: shorten this code

[Rob342]

Hi Guys

Can this code be modified or shortened, works ok just seems a bit longwinded.
[vba]
Sub ChangeColor()
Dim i As Integer
Dim ws As Worksheet
Dim Worksheet As Range

Set ws = Worksheets("PTABLE")

'// Clear the fields if user changes the month on pivot table 1
Worksheets("PTABLE").Range("Q38:X48").Interior.ColorIndex = xlNone

With ws
For i = 38 To 48
Select Case "P" & i
Case "P" & i
If Range("P" & i).Value <= 2 Then
.Range("Q" & i).Interior.ColorIndex = 10
Else
If Range("P" & i).Value > 2 And Range("P" & i).Value <= 5 Then
.Range("Q" & i).Interior.ColorIndex = 45
.Range("R" & i).Interior.ColorIndex = 45
Else
If Range("P" & i).Value > 5 And Range("P" & i).Value <= 9 Then
.Range("Q" & i).Interior.ColorIndex = 3
.Range("R" & i).Interior.ColorIndex = 3
.Range("S" & i).Interior.ColorIndex = 3
Else
If Range("P" & i).Value > 9 And Range("P" & i).Value <= 20 Then
.Range("Q" & i).Interior.ColorIndex = 3
.Range("R" & i).Interior.ColorIndex = 3
.Range("S" & i).Interior.ColorIndex = 3
.Range("T" & i).Interior.ColorIndex = 3
Else
If Range("P" & i).Value >= 21 And Range("P" & i).Value <= 30 Then
.Range("Q" & i).Interior.ColorIndex = 3
.Range("R" & i).Interior.ColorIndex = 3
.Range("S" & i).Interior.ColorIndex = 3
.Range("T" & i).Interior.ColorIndex = 3
.Range("U" & i).Interior.ColorIndex = 3
Else
If Range("P" & i).Value >= 31 And Range("P" & i).Value <= 40 Then
.Range("Q" & i).Interior.ColorIndex = 3
.Range("R" & i).Interior.ColorIndex = 3
.Range("S" & i).Interior.ColorIndex = 3
.Range("T" & i).Interior.ColorIndex = 3
.Range("U" & i).Interior.ColorIndex = 3
.Range("V" & i).Interior.ColorIndex = 3
Else
If Range("P" & i).Value >= 41 And Range("P" & i).Value <= 50 Then
.Range("Q" & i).Interior.ColorIndex = 3
.Range("R" & i).Interior.ColorIndex = 3
.Range("S" & i).Interior.ColorIndex = 3
.Range("T" & i).Interior.ColorIndex = 3
.Range("U" & i).Interior.ColorIndex = 3
.Range("V" & i).Interior.ColorIndex = 3
.Range("W" & i).Interior.ColorIndex = 3
Else
If Range("P" & i).Value >= 51 And Range("P" & i).Value <= 100 Then
.Range("Q" & i).Interior.ColorIndex = 3
.Range("R" & i).Interior.ColorIndex = 3
.Range("S" & i).Interior.ColorIndex = 3
.Range("T" & i).Interior.ColorIndex = 3
.Range("U" & i).Interior.ColorIndex = 3
.Range("V" & i).Interior.ColorIndex = 3
.Range("W" & i).Interior.ColorIndex = 3
.Range("X" & i).Interior.ColorIndex = 3
End If
End If
End If
End If
End If
End If
End If
End If
End Select
Next i
End With
End Sub

[/vba]

Rob

[mikerickson]

Try
[VBA] Dim i as Long
Dim ValueArray As Variant
Dim ColorArray As Variant
Dim Index As Variant
ValueArray = Array(100, 50, 40, 30, 20, 9, 5, 2)
ColorArray = Array(, 3, 3, 3, 3, 3, 3, 45, 10)

With Worksheets("PTABLE")
For i = 38 To 48
Index = Application.Match(.Range("P" & i).Value, Array(100, 50, 40, 30, 20, 9, 5, 2), -1)

If IsNumeric(Index) Then
Range("Q" & i).Resize(1, 9 - Index).Interior.ColorIndex = ColorArray(Index)
End If

Next i
End With[/VBA]

[Rob342]

Hi Mike

Thanks for looking, it returns on error of 438 on this line

Range("Q" & i).Resize(1, 9 - Index).Interior.ColorIndex = ColorArray(Index)
Rob

[mikerickson]

When it errors, what is the value of Index and i ?
Also,what value is in cell ["P" & i] ?

[Rob342]

Hi Mike

index = 6
i = 38

"P" & i =38

Rob
ps these are the values actually in the worksheet range P38 to P48
7.14 30.00 2.63 11.11 4.35 3.29 9.43 17.14 3.07 30.00 2.86

[Bob Phillips]

That code works fine for me with those values.

[Rob342]

Xld, Mike

Have tried it in seperate worksheet and it does work ok.

Have tried to run it as a stand alone macro stills errors on that line.

I am calling this sub from the Worksheet change event, do you think this could be the problem ?

Rob

[Rob342]

Mike, XLD

Have deleted the code & copied it back, its now working all ok, must of missed something somewhere, but looks exactly the same.

Thank you both most appreciated for your time.

Rob

[mikerickson]

Perhaps this range needs to be qualified.
[VBA] If IsNumeric(Index) Then
.Range("Q" & i).Resize(1, 9 - Index).Interior.ColorIndex = ColorArray(Index)
End If[/VBA]