Search code examples
excelchartsexcel-2007vba

Excel macro to fix overlapping data labels in line chart


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:

enter image description here

Here's an example chart where I manually fixed the data labels:

enter image description here


Solution

  • 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.

    Accessing the Labels

    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
    

    Detect Overlaps

    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
    

    Moving Labels

    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.

    Note about Excel

    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.