Adding Comments From Cells To Chart Points.

[Greg]

Hi all I have spent a large portion of my weekend trying to find the
answer to this. Without much luck! I have finally come up with my
own code and was hoping someone could have a look at it. I'm looking
to clean it up and make it a little more efficient.

Thanks in advance,
Greg.

Sub AddCommentsToChartPoints()
Dim ws As Worksheet
Dim ct As ChartObject
Dim serSeries As SeriesCollection
Dim ser As Series
Dim Counter As Integer
Dim ChartName As String
Dim xVals As String
Dim xAddress As String

'Loop through each worksheet in workbook
For Each ws In Worksheets
'Loop through each chart in worksheet
For Each ct In ws.ChartObjects
'Loop through each series in chart
For Each ser In ct.Chart.SeriesCollection
'Store the formula for the first series in xVals
xVals = ser.Formula
'Extract the range for the data from xVals
xVals = Mid(xVals, InStr(InStr(xVals, ","), xVals,
Mid(Left(xVals, InStr(xVals, "!") - 1), 9)))
xVals = Left(xVals, InStr(InStr(xVals, "!"), xVals, ",") -
1)
Do While Left(xVals, 1) = ","
xVals = Mid(xVals, 2)
Loop
'Attach a label to each data point in the chart
For Counter = 1 To Range(xVals).Cells.Count
ser.Points(Counter).HasDataLabel = True
'Get cell address of each point
xAddress = Range(xVals).Cells(Counter, 2).Address
If Range(xAddress).Comment Is Nothing Then
'Null label if no comment
ser.Points(Counter).DataLabel.Text = ""
Else
'Add Comment as label
ser.Points(Counter).DataLabel.Text =
Range(xAddress).Comment.Text
End If
Next Counter
Next ser
Next ct
Next ws

End Sub

 

[AlfD]

Hi!

First thing to note is it works. I haven't tested it strenuously, bu
what I have tried worked.

So what do you think it lacks/suffers from ?

Al

 

[Greg]

The code works with simple examples. I have however found a couple of
problems when the spreadsheets start to get more complex. The first
error I have overcome. It was populating the wrong comments if more
than one sheet was used. To fix this I have changed the following
lines of code.

'Get cell address of each point
'xAddress = Range(xVals).Cells(Counter, 2).Address
xAddress = Left(xVals, InStr(xVals,
"!"))&Range(xVals).Cells(Counter,2).Address

The second error I can't seem to solve. When there is no data for
sections of the series, it gets an error and bombs out. Usually at
the line.

ser.Points(Counter).HasDataLabel = True

Any ideas please let me know. Also if my loops could be done more
eficently please feel free to let me know.

Cheers.