jmac001
asked on
VBA Color Code Pie Slices
Could someone help me update this code need to account for if there is no Reason Code would like the slice of the pie to be Black (using index color (1)).
I added the color index to the table that I am referencing but the slices are are different colors between the 3 charts.
'Sub ColorPieSlices()
Dim NumPoints As Long, x As Long
Dim SavePtLabel As String, ThisPt As String
Dim ws As Worksheet
Dim tbReasonCodes As Range
Dim Colors As Variant, Labels As Variant, v As Variant
Dim pt As Point
On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
Set tbReasonCodes = ws.ListObjects("tbReasonCodes").DataBodyRange
If Not tbReasonCodes Is Nothing Then Exit For
Next
On Error GoTo 0
If tbReasonCodes Is Nothing Then
MsgBox "Couldn't find table for reason codes", vbOKOnly
Exit Sub
End If
'Labels = tbReasonCodes.Columns(2).Value
Labels = tbReasonCodes.Columns(3).Value
Colors = tbReasonCodes.Columns(4).Value
For Each cht In Sheets("Valiram").ChartObjects
NumPoints = cht.Chart.SeriesCollection(1).Points.Count
For x = 1 To NumPoints
Set pt = cht.Chart.SeriesCollection(1).Points(x)
SavePtLabel = ""
If pt.HasDataLabel = True Then SavePtLabel = pt.DataLabel.Text
pt.ApplyDataLabels Type:=xlDataLabelsShowLabel, AutoText:=True, HasLeaderLines:=False
ThisPt = pt.DataLabel.Text
Set v = Nothing
On Error Resume Next
v = Application.Match(ThisPt, Labels, 0)
On Error GoTo 0
If Not IsError(v) Then
pt.Interior.ColorIndex = Colors(v, 1)
End If
pt.DataLabel.Text = SavePtLabel
Next x
Next
End Sub
I added the color index to the table that I am referencing but the slices are are different colors between the 3 charts.
The code seems to pivk up reason code and colour integer from tbReasonCodes
You can add a row to the table but what will you use to define the "No reason" as a code?
Is it an existing code...? if not, we'll need to add a further if between lines 37 and 39....
Might work. might not... not sure about your data... can you post the contents of the tbReason table?
You can add a row to the table but what will you use to define the "No reason" as a code?
Is it an existing code...? if not, we'll need to add a further if between lines 37 and 39....
If Not IsError(v) Then
pt.Interior.ColorIndex = Colors(v, 1)
Else
pt.Interior.ColorIndex = 0
End If
Might work. might not... not sure about your data... can you post the contents of the tbReason table?
@Simon Bal
I had tried this in the code prior to my comment but as it did not give any significant change I responded as above.
I already worked extensively on previous question for this same workbook and fear that the issue is not clear and need to be clarified.
gowflow
I had tried this in the code prior to my comment but as it did not give any significant change I responded as above.
I already worked extensively on previous question for this same workbook and fear that the issue is not clear and need to be clarified.
gowflow
ASKER
The value for the cell can be either blank or 0 it will depend on which worksheet the data is being pulled from when creating the pie chart. If you look at the Complete tab you will see that the Reason Code Value in some instances is 0 and if you look at the Budget worksheet the Reason Code cell is blank.
The Reason Code tab has the table with the color index that is used in the VBA.
EE-Test-VSBA-Scorecard-2013.11.0.xlsm
The Reason Code tab has the table with the color index that is used in the VBA.
EE-Test-VSBA-Scorecard-2013.11.0.xlsm
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Exactly, what I was looking. Thank you.
Great !!! at least we hit in on this one.
Happy New year to you and all the best for 2014.
I would like you to (if you want) repost a question on the 3 graphs that I was not able to work in the past as to top6 and top3 will be glad to assist.
gowflow
Happy New year to you and all the best for 2014.
I would like you to (if you want) repost a question on the 3 graphs that I was not able to work in the past as to top6 and top3 will be glad to assist.
gowflow
ASKER
Thank you and Happy New Years to you as well. I will be reposting the Top 6 Top 3 just wanted to make sure that there were no changes prior to posting.
Thanks again.
Thanks again.
ok pls put a link of the new question here.
Rgds/gowflow
Rgds/gowflow
Any news on your new question ?
gowflow
gowflow
ASKER
Hi gowflow
Just posted the new question
https://www.experts-exchange.com/questions/28334923/Top-6-Reason-Codes-with-Top-3-Stores-using-VBA.html
Just posted the new question
https://www.experts-exchange.com/questions/28334923/Top-6-Reason-Codes-with-Top-3-Stores-using-VBA.html
if there is no Reason Code ?
If value = 0 ?
gowflow