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.
This macro will prevent overlapping labels on 2 line charts when data source is listed in two adjacent columns.
Attribute VB_Name = "DataLabel_Location"
Option Explicit
Sub DataLabel_Location()
'
'
' *******move data label above or below line graph depending or other line graphs in same chart***********
Dim Start As Integer, ColStart As String, ColStart1 As String
Dim RowStart As Integer, Num As Integer, x As Integer, Cell As Integer, RowEnd As Integer
Dim Chart As String, Value1 As Single, String1 As String
Dim Mycolumn As Integer
Dim Ans As String
Dim ChartNum As Integer
Ans = MsgBox("Was first data point selected?", vbYesNo)
Select Case Ans
Case vbNo
MsgBox "Select first data pt then restart macro."
Exit Sub
End Select
On Error Resume Next
ChartNum = InputBox("Please enter Chart #")
Chart = "Chart " & ChartNum
ActiveSheet.Select
ActiveCell.Select
RowStart = Selection.row
ColStart = Selection.Column
ColStart1 = ColStart + 1
ColStart = ColNumToLet(Selection.Column)
RowEnd = ActiveCell.End(xlDown).row
ColStart1 = ColNumToLet(ActiveCell.Offset(0, 1).Column)
Num = RowEnd - RowStart + 1
With ThisWorkbook.ActiveSheet.Select
ActiveSheet.ChartObjects(Chart).Activate
ActiveChart.SeriesCollection(1).ApplyDataLabels
ActiveChart.SeriesCollection(2).ApplyDataLabels
End With
For x = 1 To Num
Value1 = Range(ColStart & RowStart).Value
String1 = Range(ColStart1 & RowStart).Value
If Value1 = 0 Then
ActiveSheet.ChartObjects(Chart).Activate
ActiveChart.SeriesCollection(1).DataLabels(x).Select
Selection.Delete
End If
If String1 = 0 Then
ActiveSheet.ChartObjects(Chart).Activate
ActiveChart.SeriesCollection(2).DataLabels(x).Select
Selection.Delete
End If
If Value1 <= String1 Then
ActiveSheet.ChartObjects("Chart").Activate
ActiveChart.SeriesCollection(1).DataLabels(x).Select
Selection.Position = xlLabelPositionBelow
ActiveChart.SeriesCollection(2).DataLabels(x).Select
Selection.Position = xlLabelPositionAbove
Else
ActiveSheet.ChartObjects("Chart").Activate
ActiveChart.SeriesCollection(1).DataLabels(x).Select
Selection.Position = xlLabelPositionAbove
ActiveChart.SeriesCollection(2).DataLabels(x).Select
Selection.Position = xlLabelPositionBelow
End If
RowStart = RowStart + 1
Next x
End Sub
'
' convert column # to column letters
'
Function ColNumToLet(Mycolumn As Integer) As String
If Mycolumn > 26 Then
ColNumToLet = Chr(Int((Mycolumn - 1) / 26) + 64) & Chr(((Mycolumn - 1) Mod 26) + 65)
Else
ColNumToLet = Chr(Mycolumn + 64)
End If
End Function
Allthough I agree that regular Excel formulas can't fix everything, I dislike VBA. There are several reasons for this, but the most important one is that chances are it will stop working with the next upgrade. I'm not saying you shouldn't use VBA at all, but only use it when necessary.
Your question is a good example of a need where VBA isn't necessary.. "OK" you say, "but then how do I fix this problem?" Feel lucky and click this link to my answer to a related question here.
What you'll find out in the link is, how you can measure your charts' exact grid. When your x-axis crosses at 0, you'll only need the maximum Y-axis label for that. You're only half way there now, cause your specific problem isn't solved yet. Here's how I would proceed:
First measure how high your labels are compared to the height of your chart. This will need some trial and error, but shouldnt be very difficult. If your chart can stack 20 labels without overlapping, this number would be 0.05 for example.
Next determine if and where any of the labels would overlap. This is quite easy, cause all you need to do is find out where numbers are too close to each other (within the 0.05 range in my example).
Use some boolean tests or for all I care IF formulas to find out. The result you're after is a table with the answers for each of the series (except the first one). Don't be afraid to duplicate that table again for the next step: creating the new chart input.
There are several ways to create the new chart, but here's the one I'd choose. For each of the series create three lines. One is the actual line, the other two are the invisible lines with just the data labels. For each of the lines there is one invisible line with just the regular labels. Those all use the same alignment. Each extra invisible line has a different allignment for the labels. You won't need one for your first series, but for the second one the label would be to the right, the third one beneath and the fourth one to the left (for example).
When none of the data labels overlap only the first invisible lines (with regular alignment) need to show the values. When labels do overlap, the corresponding extra invisible line should take over on that point and show its label. Of course the first invisible line should not show one there.
When all four labels overlap at the same x-axis value, you should see the first basic invisible line's label and the three extra invisible lines' labels. This should work for your example chart, cause there is enough room to move to labels to the left and right. Personally I'd stick with just the minimum and the maximum label at an overlapping point, cause the fact it overlaps shows the values are pretty close to each other in the first place..
I hope this helped you,
Greetings,
Patrick
@chris neilsen Could you test your solution on Excel 2007? When I cast the objects to DataLabel class, it looks like the .Width property has been removed from the class. (Sorry, I was not permitted to comment on your reply)
Maybe one thing to add from below forum is to temporary adjust position of label: http://www.ozgrid.com/forum/showthread.php?t=90439 "you get close width or height value of the data label by forcing the label off of the chart and comparing the reported left/top value to that of the chartarea inside width/height."
Based on this, please move v(i).Width & v(j).Width to a variables sng_vi_Width & sng_vj_Width and add these lines
With v(i)
sngOriginalLeft = .Left
.Left = .Parent.Parent.Parent.Parent.ChartArea.Width
sng_vi_Width = .Parent.Parent.Parent.Parent.ChartArea.Width - .Left
.Left = sngOriginalLeft
End With
With v(j)
sngOriginalLeft = .Left
.Left = .Parent.Parent.Parent.Parent.ChartArea.Width
sng_vj_Width = .Parent.Parent.Parent.Parent.ChartArea.Width - .Left
.Left = sngOriginalLeft
End With
