Avoiding overlapping labels in charts

[Allan91]

Hi guys,

I have created this book with a ton of formulas and macros within it which boils down to a line chart to compare sales of 2 objects over months dynamically. My problem is that if the sales figures for the two objects in the same month are too close to each other after entering new data, the labels I have set for the line charts overlap. Is there a solution for this (be it with VBA or without)?

Thanks for your help!

 

[NdNoviceHlp]

Hi Allen. You can place and adjust your data labels with VBA as below. You can probably also do it manually without VBA as well. I'm guessing the position is the only relevant thing but I've included some other stuff for U to mess with. HTH. Dave

With Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(1).DataLabels
.position = xlLabelPositionAbove
.Orientation = xlHorizontal
.AutoScaleFont = False
.Font.Size = 13
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 3 'red
End With

With Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(2).DataLabels
.position = xlLabelPositionBelow
.Orientation = xlHorizontal
.AutoScaleFont = False
.Font.Size = 13
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 5 'blue
End With

Adjust sheet name, chart object number and series number to suit

 

[Allan91]

Hi Allen. You can place and adjust your data labels with VBA as below. You can probably also do it manually without VBA as well. I'm guessing the position is the only relevant thing but I've included some other stuff for U to mess with. HTH. Dave

With Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(1).DataLabels
.position = xlLabelPositionAbove
.Orientation = xlHorizontal
.AutoScaleFont = False
.Font.Size = 13
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 3 'red
End With

With Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(2).DataLabels
.position = xlLabelPositionBelow
.Orientation = xlHorizontal
.AutoScaleFont = False
.Font.Size = 13
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 5 'blue
End With

Adjust sheet name, chart object number and series number to suit

Hi ND. Good thinking with label position above and below but I tried that earlier and there are two problems with it as you can see in the new image I uploaded. The series can still overlap given the suitable situation. And when I use label position below it overlaps the x axis in most of the cases. I'm guessing I need a code with an if statement or something.

Thank you for your help though! It might well help some other people on the forum.

 

[NdNoviceHlp]

There are quite a few other label positions that might help...
XlDataLabelPosition enumeration (Excel) | Microsoft Docs
I'll mess with some conditional placement but I'm not sure if that will work? Dave

 

[NdNoviceHlp]

I "borrowed" and adapted some code from Jon Peltier. You can give this a trial. Seems to work. Dave

Function GetYValue(cht As Chart, iSrsNum As Long, iPtNum As Long) As String
  Dim srs As Series, vCats As Variant
  Set srs = cht.SeriesCollection(iSrsNum)
  vCats = srs.Values
  GetYValue = vCats(iPtNum)
End Function

Function GetYLabel(iSrs As Long, ipt As Long) As Double
  Dim s As String, cht As Chart
  Set cht = ActiveSheet.ChartObjects(1).Chart
  s = GetYValue(cht, iSrs, ipt)
GetYLabel = s
End Function

Private Sub Test()
Dim cnt As Long
For cnt = 1 To Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(1).Points.Count
If GetYLabel(1, cnt) >= GetYLabel(2, cnt) Then

With Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(1).Points(cnt).DataLabel
.Position = xlLabelPositionAbove
.Orientation = xlHorizontal
.AutoScaleFont = False
.Font.Size = 13
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 3 'red
End With
Else
With Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(1).Points(cnt).DataLabel
.Position = xlLabelPositionBelow
.Orientation = xlHorizontal
.AutoScaleFont = False
.Font.Size = 13
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 3 'red
End With
End If

Call Test to operate. Adjust sheet name, chart name and series numbers to suit

 

[Allan91]

I "borrowed" and adapted some code from Jon Peltier. You can give this a trial. Seems to work. Dave

Function GetYValue(cht As Chart, iSrsNum As Long, iPtNum As Long) As String
  Dim srs As Series, vCats As Variant
  Set srs = cht.SeriesCollection(iSrsNum)
  vCats = srs.Values
  GetYValue = vCats(iPtNum)
End Function

Function GetYLabel(iSrs As Long, ipt As Long) As Double
  Dim s As String, cht As Chart
  Set cht = ActiveSheet.ChartObjects(1).Chart
  s = GetYValue(cht, iSrs, ipt)
GetYLabel = s
End Function

Private Sub Test()
Dim cnt As Long
For cnt = 1 To Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(1).Points.Count
If GetYLabel(1, cnt) >= GetYLabel(2, cnt) Then

With Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(1).Points(cnt).DataLabel
.Position = xlLabelPositionAbove
.Orientation = xlHorizontal
.AutoScaleFont = False
.Font.Size = 13
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 3 'red
End With
Else
With Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(1).Points(cnt).DataLabel
.Position = xlLabelPositionBelow
.Orientation = xlHorizontal
.AutoScaleFont = False
.Font.Size = 13
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 3 'red
End With
End If

Call Test to operate. Adjust sheet name, chart name and series numbers to suit

Hi Dave!

First of all I'd like to thank you for your determination to solve this, much appreciated!

The code sort of worked (I think) at for some labels and not for the others. Please see the new image. In some cases labels in both lines turned to red in some cases none. But there still is overlapping. I am attaching my version of the code maybe you could spot what I am doing wrong?

All I have done so far is writing in the sheet name, chart name, series number (1 and 2), put a next at the end and write in end sub at the end. Please have a look see at the code.

All the best and happy holidays!

Function GetYValue(cht As Chart, iSrsNum As Long, iPtNum As Long) As String
  Dim srs As Series, vCats As Variant
  Set srs = cht.SeriesCollection(iSrsNum)
  vCats = srs.Values
  GetYValue = vCats(iPtNum)
End Function

Function GetYLabel(iSrs As Long, ipt As Long) As Double
  Dim s As String, cht As Chart
  Set cht = ActiveSheet.ChartObjects(1).Chart
  s = GetYValue(cht, iSrs, ipt)
GetYLabel = s
End Function

Private Sub Test()
Dim cnt As Long
For cnt = 1 To Sheets("Expense Analysis Dashboard").ChartObjects("Chart 38").Chart.SeriesCollection(1).Points.Count
If GetYLabel(1, cnt) >= GetYLabel(2, cnt) Then

With Sheets("Expense Analysis Dashboard").ChartObjects("Chart 38").Chart.SeriesCollection(1).Points(cnt).DataLabel
.Position = xlLabelPositionAbove
.Orientation = xlHorizontal
.AutoScaleFont = False
.Font.Size = 13
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 3 'red
End With
Else
With Sheets("Expense Analysis Dashboard").ChartObjects("Chart 38").Chart.SeriesCollection(2).Points(cnt).DataLabel
.Position = xlLabelPositionBelow
.Orientation = xlHorizontal
.AutoScaleFont = False
.Font.Size = 13
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 3 'red
End With
End If

Next

End Sub

 

[NdNoviceHlp]

Hmmm.... for some reason the whole code didn't post and I didn't notice? Dave

Sub test()
Dim cnt As Long
For cnt = 1 To Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(1).Points.Count
If GetYLabel(1, cnt) >= GetYLabel(2, cnt) Then

With Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(1).Points(cnt).DataLabel
.Position = xlLabelPositionAbove
.Orientation = xlHorizontal
.AutoScaleFont = False
.Font.Size = 13
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 3 'red
End With
Else
With Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(1).Points(cnt).DataLabel
.Position = xlLabelPositionBelow
.Orientation = xlHorizontal
.AutoScaleFont = False
.Font.Size = 13
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 3 'red
End With
End If
Next cnt

For cnt = 1 To Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(2).Points.Count
If GetYLabel(2, cnt) > GetYLabel(1, cnt) Then
With Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(2).Points(cnt).DataLabel
.Position = xlLabelPositionAbove
.Orientation = xlHorizontal
.AutoScaleFont = False
.Font.Size = 13
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 5 'blue
End With
Else
With Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(2).Points(cnt).DataLabel
.Position = xlLabelPositionBelow
.Orientation = xlHorizontal
.AutoScaleFont = False
.Font.Size = 13
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 5 '5 blue
End With
End If
Next cnt
End Sub

edit: again make changes to sheet name, chart name & series to suit. Also change the color to your series color. You also continue to need the 2 functions...

Function GetYValue(cht As Chart, iSrsNum As Long, iPtNum As Long) As String
  Dim srs As Series, vCats As Variant
  Set srs = cht.SeriesCollection(iSrsNum)
  vCats = srs.Values
  GetYValue = vCats(iPtNum)
End Function

Function GetYLabel(iSrs As Long, ipt As Long) As Double
  Dim s As String, cht As Chart
  Set cht = ActiveSheet.ChartObjects(1).Chart
  s = GetYValue(cht, iSrs, ipt)
GetYLabel = s
End Function