Andreas Hermle
asked on
Highlight the max value of the Data Labels in all of the Excel Charts
Dear Experts:
below macro deletes all data labels featuring 0% values from all the charts of the active worksheet. The macro works just fine. Could somebody help me re-write this code so that the additonal following requirements are met.
I would like to change the font color (to white) of the data labels in all Excel charts of the current worksheet to highlight the maximum values.
There is a tutorial on this on the web by:
http://peltiertech.com/WordPress/highlight-specific-data-label-in-excel-chart/
But I was not able to adjust that sample code to accommodate my requirements.
The code somebody will come up with hopefully can be a stand-alone code of course, it does not need to be incorporated in the code below.
Help is very much appreciated. Thank you very much in advance.
Regards, andreas
below macro deletes all data labels featuring 0% values from all the charts of the active worksheet. The macro works just fine. Could somebody help me re-write this code so that the additonal following requirements are met.
I would like to change the font color (to white) of the data labels in all Excel charts of the current worksheet to highlight the maximum values.
There is a tutorial on this on the web by:
http://peltiertech.com/WordPress/highlight-specific-data-label-in-excel-chart/
But I was not able to adjust that sample code to accommodate my requirements.
The code somebody will come up with hopefully can be a stand-alone code of course, it does not need to be incorporated in the code below.
Help is very much appreciated. Thank you very much in advance.
Regards, andreas
Sub CleanUpChartLabels()
Dim iPts As Integer
Dim nPts As Integer
Dim aVals As Variant
Dim srs As Series
Dim myChtObj As ChartObject
If msgbox("Would you like to delete 0% datalabels? ... " & vbCrLf & _
"... i.e. all Data labels featuring just 0% of the total count of " & ActiveSheet.ChartObjects.Count & " Charts will be deleted?", vbQuestion + vbYesNo, "0% Datalabels") = vbNo Then
Exit Sub
End If
For Each myChtObj In ActiveSheet.ChartObjects
With myChtObj.Chart
For Each srs In .SeriesCollection
With srs
If .HasDataLabels Then
nPts = .Points.Count
' i = i + 1
aVals = .Values
For iPts = 1 To nPts
If aVals(iPts) = 0 Then
.Points(iPts).HasDataLabel = False
End If
Next
End If
End With
Next
End With
Next
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
great this did the trick. Thank you very much for your great and swift support.
Regards, Andreas