Rob342
08-20-2011, 03:35 PM
Hi Guys
Can this code be modified or shortened, works ok just seems a bit longwinded.
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
Rob
Can this code be modified or shortened, works ok just seems a bit longwinded.
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
Rob