I am searching/trying to make a macro to fix the position of data labels in a line chart with one or multiple series collections so that they will not overlap each other.
I was thinking of some ways for my macro but when I try to make it I understand that this is way too hard for me and I get headache.
Is there anything that I missed? Do you know about such a macro?
Here's an example chart with overlapped data labels:
Here's an example chart where I manually fixed the data labels:
This task basically breaks down to two steps: access the Chart
object to get the Labels
, and manipulate the label positions to avoid overlap.
For the sample given all series are plotted on a common X-axis and the X values are sufficiently spread that labels don't overlap in this dimension. Therefore the solution offered only deals with groups of labels for each X point in turn.
This Sub
parses the chart and creates an array of Labels
for each X point in turn
Sub MoveLabels()
Dim sh As Worksheet
Dim ch As Chart
Dim sers As SeriesCollection
Dim ser As Series
Dim i As Long, pt As Long
Dim dLabels() As DataLabel
Set sh = ActiveSheet
Set ch = sh.ChartObjects("Chart 1").Chart
Set sers = ch.SeriesCollection
ReDim dLabels(1 To sers.Count)
For pt = 1 To sers(1).Points.Count
For i = 1 To sers.Count
Set dLabels(i) = sers(i).Points(pt).DataLabel
Next
AdjustLabels dLabels ' This Sub is to deal with the overlaps
Next
End Sub
This calls AdjustLables
with an array of Labels
. These labels need to be checked for overlap
Sub AdjustLabels(ByRef v() As DataLabel)
Dim i As Long, j As Long
For i = LBound(v) To UBound(v) - 1
For j = LBound(v) + 1 To UBound(v)
If v(i).Left <= v(j).Left Then
If v(i).Top <= v(j).Top Then
If (v(j).Top - v(i).Top) < v(i).Height _
And (v(j).Left - v(i).Left) < v(i).Width Then
' Overlap!
End If
Else
If (v(i).Top - v(j).Top) < v(j).Height _
And (v(j).Left - v(i).Left) < v(i).Width Then
' Overlap!
End If
End If
Else
If v(i).Top <= v(j).Top Then
If (v(j).Top - v(i).Top) < v(i).Height _
And (v(i).Left - v(j).Left) < v(j).Width Then
' Overlap!
End If
Else
If (v(i).Top - v(j).Top) < v(j).Height _
And (v(i).Left - v(j).Left) < v(j).Width Then
' Overlap!
End If
End If
End If
Next j, i
End Sub
When an overlap is detected you need a strategy that move one or both labels without creating another overlap.
There are many possibilities here, you havn'e given sufficient details to judge your requirements.
For this approach to work you need a version of Excel that has DataLabel.Width and DataLabel.Height properties. Version 2003 SP2 (and, presumably, earlier) does not.