VBA to apply data labels to specific sections of a PivotChart

[kidwispa]

Hi All,

I have the following code that applies the required formatting to each field in my pivot chart:

Sub COBA()
    Dim i As Long
 
    Sheets("Claim Outcomes by Agent").Select
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.PlotArea.Select
 
    With ActiveChart
        For i = 1 To .SeriesCollection.Count
            With .SeriesCollection(i).Format.Fill
                Select Case .Parent.Parent.Name
                    Case "Paid"
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(0, 128, 0)
                    .Transparency = 0
                    .Solid
                    Case "Pending - Details sent to FedEx"
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(255, 204, 0)
                    .Transparency = 0
                    .Solid
                    Case "Rejected - Outside Agreed Timeframe"
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(255, 0, 0)
                    .Transparency = 0
                    .Solid
                    Case "Rejected < £20.00"
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(246, 197, 192)
                    .Transparency = 0
                    .Solid
                 End Select
 
            End With
          Next i
        End With

This works great however I would now also like to add data labels in a specific format for 2 of the cases ("Rejected - Outside Agreed Timeframe" and "Paid") whilst leaving the other two blank.

I have this code:

ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).ApplyDataLabels
    ActiveChart.SeriesCollection(1).DataLabels.Select
    Selection.Position = xlLabelPositionInsideEnd
    Selection.NumberFormat = "\£0;;;"

Which is the correct format I want the data labels to appear in, I'm just confused as to what needs changing and where I need to put it on the first piece of code to make it work... any ideas?

Thanks in advance

 

[Andrew Poulsom]

Try the untested:

           With .SeriesCollection(i).Format.Fill
                Select Case .Parent.Parent.Name
                    Case "Paid"
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(0, 128, 0)
                    .Transparency = 0
                    .Solid
                    With .Parent.Parent
                        .ApplyDataLabels
                        With .DataLabels
                            .Position = xlLabelPositionInsideEnd
                            .NumberFormat = "\£0;;;"
                        End With
                    End With
                    Case "Pending - Details sent to FedEx"
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(255, 204, 0)
                    .Transparency = 0
                    .Solid
                    Case "Rejected - Outside Agreed Timeframe"
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(255, 0, 0)
                    .Transparency = 0
                    .Solid
                    With .Parent.Parent
                        .ApplyDataLabels
                        With .DataLabels
                            .Position = xlLabelPositionInsideEnd
                            .NumberFormat = "\£0;;;"
                        End With
                    End With
                    Case "Rejected < £20.00"
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(246, 197, 192)
                    .Transparency = 0
                    .Solid
                 End Select
            End With

 

[kidwispa]

Hi Andrew,

Thanks for the speedy response - I've amended the code in line with what you have written and I'm getting the error "Compile Error - For Without Next" - can you help?

Sub COBA()
    Dim i As Long
    
    Sheets("Claim Outcomes by Agent").Select
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.PlotArea.Select
        
    With ActiveChart
        For i = 1 To .SeriesCollection.Count
            With .SeriesCollection(i).Format.Fill
                Select Case .Parent.Parent.Name
                    Case "Paid"
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(0, 128, 0)
                    .Transparency = 0
                    .Solid
                    With .Parent.Parent
                        .ApplyDataLabels
                        With .DataLabels
                            .Position = xlLabelPositionInsideEnd
                            .NumberFormat = "\£0;;;"
                        End With
                    End With
                    Case "Pending - Details sent to FedEx"
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(255, 204, 0)
                    .Transparency = 0
                    .Solid
                    Case "Rejected - Outside Agreed Timeframe"
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(255, 0, 0)
                    .Transparency = 0
                    .Solid
                    With .Parent.Parent
                        .ApplyDataLabels
                        With .DataLabels
                            .Position = xlLabelPositionInsideEnd
                            .NumberFormat = "\£0;;;"
                        End With
                    End With
                    Case "Rejected < £20.00"
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(246, 197, 192)
                    .Transparency = 0
                    .Solid
                 End Select
            End With
        
End Sub

 

[Andrew Poulsom]

You are missing an Exit For and an End With before End Sub. I only amended part of the code.

 

[kidwispa]

You are missing an Exit For and an End With before End Sub. I only amended part of the code.

Thanks for your help Andrew - this seems to work as a solution:

Sub COBA()
    Dim i As Long
    
    Sheets("Claim Outcomes by Agent").Select
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.PlotArea.Select
        
    With ActiveChart
        For i = 1 To .SeriesCollection.Count
            With .SeriesCollection(i).Format.Fill
                Select Case .Parent.Parent.Name
                    Case "Paid"
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(0, 128, 0)
                    .Transparency = 0
                    .Solid
                    With .Parent.Parent
                        .ApplyDataLabels
                        With .DataLabels
                            .Position = xlLabelPositionInsideEnd
                            .NumberFormat = "\£0;;;"
                        End With
                    End With
                    Case "Pending - Details sent to FedEx"
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(255, 204, 0)
                    .Transparency = 0
                    .Solid
                    Case "Rejected - Outside Agreed Timeframe"
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(255, 0, 0)
                    .Transparency = 0
                    .Solid
                    With .Parent.Parent
                        .ApplyDataLabels
                        With .DataLabels
                            .Position = xlLabelPositionInsideEnd
                            .NumberFormat = "\£0;;;"
                        End With
                    End With
                    Case "Rejected < £20.00"
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(246, 197, 192)
                    .Transparency = 0
                    .Solid
                 End Select
            End With
            Next i
          End With
       
End Sub