Solved

VBA Color Code Pie Slices

Posted on 2013-12-24
11
473 Views
Last Modified: 2014-01-09
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)).

'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

Open in new window


I added the color index to the table that I am referencing but the slices are are different colors between the 3 charts.
0
Comment
Question by:jmac001
  • 6
  • 4
11 Comments
 
LVL 29

Expert Comment

by:gowflow
ID: 39739349
What do you mean by
 if there is no Reason Code  ?
If value = 0 ?

gowflow
0
 
LVL 15

Expert Comment

by:Simon Ball
ID: 39745836
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....

If Not IsError(v) Then
            pt.Interior.ColorIndex = Colors(v, 1)
Else
pt.Interior.ColorIndex = 0
End If

Open in new window


Might work.  might not... not sure about your data... can you post the contents of the tbReason table?
0
 
LVL 29

Expert Comment

by:gowflow
ID: 39746068
@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
0
 

Author Comment

by:jmac001
ID: 39746525
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
0
 
LVL 29

Accepted Solution

by:
gowflow earned 500 total points
ID: 39747209
Hi Jmac001,

Is this what your looking for ? Activate macro CreatePie and check the results.
gowflow
EE-Test-VSBA-Scorecard-2013.12.3.xlsm
0
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 

Author Closing Comment

by:jmac001
ID: 39748678
Exactly, what I was looking. Thank you.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 39748778
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
0
 

Author Comment

by:jmac001
ID: 39751262
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.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 39751823
ok pls put a link of the new question here.
Rgds/gowflow
0
 
LVL 29

Expert Comment

by:gowflow
ID: 39761534
Any news on your new question ?
gowflow
0
 

Author Comment

by:jmac001
ID: 39769658
0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
TT Text To Column Based On Criteria 3 18
Excel 6 19
Rearrange Macro 7 25
Find missing excel values from Column A and B 4 19
A2 = A1 That kind of cell reference is relative.  If you copy it from A2 to B2, then B2 will get this: B2 = B1 That's all fine and good, but if you then insert a new row above row 2, you'll find: A3 = A1 B3 = B1 This is intentional. …
Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now