CODEWITHSUNDEEP
vbaexcel
user9027572
user9027572

Reputation: 13

Need VBA excel chart code to include Title and Legend label

The below code generates individual doughnut charts for all rows of data but we need it to include the first cell in each row as the title and the column headers for the corresponding Legend labels. We're not experienced in VBA and have tried to tweak it unsuccessfully. Our end users have Excel 2010 if that matters. I'm hoping this is an easy fix/edit. Anyone able to assist??

Sample Data:

Name----Data1----Data2----Data3

John____23______32_____14

Terry___456_____125_____104

Mike____109______6______98

Code:

Sub AutoCreateCharts()
    Dim i As Long
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim chrt As Chart
    LastRow = Sheets("Sheet1").Range("A3000").End(xlUp).Row
    LastColumn = Sheets("Sheet1").Range("A1").End(xlToRight).Column

    For a = 2 To LastRow
        Sheets("Sheet2").Select
        Set chrt = Sheets("Sheet2").Shapes.AddChart.Chart
        chrt.ChartType = xlDoughnut
        With Sheets("Sheet1")
            chrt.SetSourceData Source:=.Range(.Cells(a, 2), .Cells(a, LastColumn))
        End With

        chrt.ChartArea.Left = 1
        chrt.ChartArea.Top = (a - 2) * chrt.ChartArea.Height
    Next    
End Sub

Upvotes: 1

Views: 2880

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149325

To add a Title, use .HasTitle = True and then set the text using .ChartTitle.Text

To add the legend use .HasLegend = True. But then this is not enough. You need to set the source data to inculde the header row so that the series names can be automatically captured by the code.

Is this what you are trying?

Sub AutoCreateCharts()
    Dim i As Long, LastRow As Long, LastColumn As Long
    Dim chrt As Chart
    Dim rng As Range

    LastRow = Sheets("Sheet1").Range("A3000").End(xlUp).Row
    LastColumn = Sheets("Sheet1").Range("A1").End(xlToRight).Column

    For i = 2 To LastRow
        Set chrt = Sheets("Sheet2").Shapes.AddChart.Chart

        chrt.ChartType = xlDoughnut
        chrt.HasLegend = True '<~~ Add the legend

        With Sheets("Sheet1")
            '~~> Include the First row in the source data
            chrt.SetSourceData Source:=Union(.Range(.Cells(1, 2), .Cells(1, LastColumn)), _
                                             .Range(.Cells(i, 2), .Cells(i, LastColumn)))

            chrt.HasTitle = True '<~~ Add the Chart Title
            chrt.ChartTitle.Text = .Cells(i, 1).Value '<~~ Set the text
        End With

        chrt.ChartArea.Left = 1
        chrt.ChartArea.Top = (a - 2) * chrt.ChartArea.Height
    Next
End Sub

Data

enter image description here

Screenshot

enter image description here

Upvotes: 1

Related Questions