How do I automate color coding the highest performers on a chart?

[worthm]

Hello,
I use Office 2010 and I've attached the spreadsheet. It should open on the tab "CSR claims area". I update these charts daily and I use green bars for everyone for the chart bars and blue for the top three performers. How can I make it so that it automatically changes the colors to blue for the highest ranked team mates and leaves the rest of the bars green as the data changes? This most likely requires a piece of VB code but I'm not a programmer. I can copy and paste though

Thanks in advance

13039

[apo]

Hi.. try this..

If you change a value with the range(D5:P18).. your 2 charts will automatically update there bar colors accordingly.



Private Sub Worksheet_Change(ByVal Target As Range)
Dim ch, x, xx, i As Long, ii As Long, j As Long
If Not Intersect(Target, Range("D5:P18")) Is Nothing Then
Application.EnableEvents = False
ch = Array("Chart 2", "Chart 3")
For i = 0 To 1
x = Sheets("CSR claims area").ChartObjects(ch(i)).Chart.SeriesCollection(1).Values
With CreateObject("system.collections.arraylist")
For j = 1 To UBound(x)
.Add x(j)
Next j
.Sort: .Reverse
xx = .toarray()
End With
For ii = LBound(x) To UBound(x)
If x(ii) < xx(2) Then
Sheets("CSR claims area").ChartObjects(ch(i)).Chart.SeriesCollection(1).Points(ii).Interior.Color = RGB(0, 255, 0)
Else
Sheets("CSR claims area").ChartObjects(ch(i)).Chart.SeriesCollection(1).Points(ii).Interior.Color = RGB(0, 204, 255)
End If
Next ii
Next i
Application.EnableEvents = True
End If
End Sub

[worthm]

Hello and thank you. Ive plugged your piece of code into the section for that tab but the color didn't change when I added more to a given employee's stats. The chart updated but that's an Excel function. I don't know why your code didn't work. Ive been manually editing the colors. Do I need to set them all to green for it to work?

[apo]

Did you try the Workbook I attached?

Changing values on the CSR claims area sheet (D5:P18) will automatically adjust both charts on that page (top 3 will be blue.. rest will be green)..

You might be putting the code in the wrong place..

[worthm]

OK, I didn't see that you had added your attachment. Here is the problem: If I change the data directly on that page, the colors do change. I am, however, pulling that data from another page. When I update the data on that other page and it pulls to this page, the colors don't change. How do I get it to see that the data has changed?

Thanks for your help. We're close

[apo]

Hi..

You need to use the Worksheet_Calculate Event instead then..

Can't say I have even used it before.. but i found some code here byChris Neilsen that I incorporated into my existing code:

http://stackoverflow.com/questions/15694757/how-to-run-vba-code-when-cell-contents-are-changed-via-formula

So.. replace the existing code you have (teh Worksheet_Change code).. with the following:



Private Sub Worksheet_Calculate()
Dim rng As Range, cl As Range
Dim ch, x, xx, i As Long, ii As Long, j As Long
Static OldData As Variant


Application.EnableEvents = False
Set rng = Me.Range("E5:P18")


If IsEmpty(OldData) Then
OldData = rng.Value
End If
For Each cl In rng.Cells
If cl.Value <> OldData(cl.Row - rng.Row + 1, 1) Then

Application.EnableEvents = False

' Put your 2 charts names in an array
ch = Array("Chart 2", "Chart 3")

' Setup a loop that loops through all 2 charts
' Better way would be: For i = Lbound(ch) to Ubound(ch)
For i = 0 To 1

' Put the values from your chart into an array
x = Sheets("CSR claims area").ChartObjects(ch(i)).Chart.SeriesCollection(1).Values

' Loop through the array, adding the values to an arraylist
With CreateObject("system.collections.arraylist")
For j = 1 To UBound(x)
.Add x(j)
Next j

' Sort values in your array list and then reverse the order
' This will get your values in descending order
.Sort: .Reverse

' Put the arraylist into a new array
xx = .toarray()
End With

' Setup a loop that tests to see if a value in small than the top 3 values
' In heindsight.. it would have been more efficient to just have a loop going from 0 to 2 (negating the need for the If test)
For ii = LBound(x) To UBound(x)
If x(ii) < xx(2) Then
' If it is smaller.. make it green
Sheets("CSR claims area").ChartObjects(ch(i)).Chart.SeriesCollection(1).Points(ii).Interior.Color = RGB(0, 255, 0)
Else
' If it is NOT smaller.. make it blue
Sheets("CSR claims area").ChartObjects(ch(i)).Chart.SeriesCollection(1).Points(ii).Interior.Color = RGB(0, 204, 255)
End If
Next ii
Next i
Application.EnableEvents = True
End If
Next
OldData = rng.Value
Application.EnableEvents = True
End Sub

[worthm]

Thank you! I'll admit that I don't understand the VB but it works beautifully. Thanks again!

[apo]

No worries.. I have updated the code in my Post #6 with some commenting in the code.. it should shed some light on what i was thinking..