Reputation: 12353
I am facing an issue with a bubble chart when criteria1
and criteria2
in the below table have the same values. The data label and data series overlap each other. In such cases making it difficult to read them. How can this be fixed?
+------------+-----------+-----------+
| City | criteria1 | criteria2 |
+------------+-----------+-----------+
| Thane | 4 | 3 |
| Mumbai | 3 | 2 |
| Pune | 5 | 1 |
| Goa | 2 | 3 |
| Chandigarh | 3 | 1 |
+------------+-----------+-----------+
Overlapping issue
Upvotes: 0
Views: 7569
Reputation: 12353
Added a refresh button next to chart which adjust the data labels. Below is the code behind the button.
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
resetLabels dLabels
AdjustLabels dLabels ' This Sub is to deal with the overlaps
Next
End Sub
Private Sub AdjustLabels(ByRef v() As DataLabel)
Application.ScreenUpdating = False
Dim i As Long, j As Long, adj As Long
Dim temp_a As String, temp_b As String
For i = LBound(v) To UBound(v) - 1
For j = LBound(v) + 1 To UBound(v)
temp_a = v(i).Caption
temp_b = v(j).Caption
Debug.Print temp_a & " - | - " & temp_b
v(i).Caption = "a"
v(j).Caption = IIf(temp_a = temp_b, "a", "b")
ActiveSheet.ChartObjects("Chart 1").Activate
If ((v(j).Top = v(i).Top) And (v(i).Caption <> v(j).Caption) And (v(j).Left = v(i).Left)) Then
Select Case v(j).Position
Case xlLabelPositionAbove
v(j).Position = xlLabelPositionRight
Case xlLabelPositionRight
v(j).Position = xlLabelPositionBelow
Case xlLabelPositionBelow
v(j).Position = xlLabelPositionLeft
Case xlLabelPositionLeft
v(j).Position = xlLabelPositionAbove
End Select
End If
v(i).Caption = temp_a
v(j).Caption = temp_b
temp_a = vbNullString
temp_b = vbNullString
Next j, i
Application.ScreenUpdating = True
End Sub
Sub resetLabels(ByRef v() As DataLabel)
For i = LBound(v) To UBound(v) - 1
v(i).Position = xlLabelPositionAbove
Next
End Sub
Upvotes: 1
Reputation: 15641
You can:
See https://stackoverflow.com/a/27813339/2707864 (related).
For an automated work, I suggest you get the awesome XY Chart Labeler and use it as a basis for your VBA code. The required code will not be short. I give you here a schematics:
* It is quite instructive to see how this works, sometimes you would be able to select an object that would be otherwise difficult/impossible to select with the mouse.
Upvotes: 1