Excel 2007, How to avoid scatter chart data points overlap - excel

Question

I have a workbook and the following sheets
Dashboard, IImpactchart.
Dashboard, which have candidate name, influence reference and impact reference
Candidate | Impact | Influence
Which have values of
Candidate1, Impact value = 3, Influence value = 2
Candate 2, Impact value = 3, Influence value =2
In the chart, we need to display the corresponding row number in the coordinate of (3,2). Its plotting for only single candidate. If we have more candidate with same value, the data-points are overlapping one above the other. How can we shift the data-points separated by commas ?? or any other way.
Chart attached
Please click here to see the Chart output
Chart Required
Please click here to see the required chart
VBA used
Dim Counter As Integer, ChartName As String, xVals As String
Application.ScreenUpdating = False
Dim c As ChartObject
Set c = Sheets("IImpactchart").ChartObjects("Chart 1")
c.Activate
xVals = ActiveChart.SeriesCollection(1).Formula
xVals = Mid(xVals, InStr(InStr(xVals, ","), xVals, _
Mid(Left(xVals, InStr(xVals, "!") - 1), 9)))
xVals = Left(xVals, InStr(InStr(xVals, "!"), xVals, ",") - 1)
Do While Left(xVals, 1) = ","
xVals = Mid(xVals, 2)
Loop
For Counter = 1 To Range(xVals).Cells.Count
If (Range(xVals).Cells(Counter, 1).Offset(0, -1).Value = 0) Then
Exit Sub
End If
ActiveChart.SeriesCollection(1).Points(Counter).HasDataLabel = _
True
ActiveChart.SeriesCollection(1).Points(Counter).DataLabel.Text = Counter + 5
Next Counter
(Counter is to increment by 5 to get the correct row number) - its working
Now i need to solve the overlapping.
Help appreciated..
Thanks

Answer 1

Assuming that your current code works and that the only problem is the overlap, the code below should solve your problem.
This solution involves the use of an array named LabelArray that stores the point number of the first point to occupy the spot on the grid. Then, instead of creating a new label for the new points, it simply adds to the existing label of that first point.
Sub LabelsNoOverlap()
Dim Counter As Integer, ChartName As String, xVals As String, yVals As String
Application.ScreenUpdating = False
Dim c As ChartObject
Set c = Sheets("IImpactchart").ChartObjects("Chart 2")
c.Activate
'Find address of the X values
xVals = ActiveChart.SeriesCollection(1).Formula
xVals = Mid(xVals, InStr(InStr(xVals, ","), xVals, _
Mid(Left(xVals, InStr(xVals, "!") - 1), 9)))
xVals = Left(xVals, InStr(InStr(xVals, "!"), xVals, ",") - 1)
'Not sure why this loop from your code is useful, but let's leave it.
Do While Left(xVals, 1) = ","
xVals = Mid(xVals, 2)
Loop
'Find address of the Y values
yVals = ActiveChart.SeriesCollection(1).Formula
yVals = Mid(yVals, InStr(InStr(yVals, ","), yVals, _
Mid(Left(yVals, InStr(yVals, "!") - 1), 9)))
yVals = Right(yVals, Len(yVals) - InStr(yVals, ","))
yVals = Left(yVals, InStr(InStr(yVals, "!"), yVals, ",") - 1)
'Again, not sure why this loop from your code is useful, but let's leave it.
Do While Left(yVals, 1) = ","
yVals = Mid(yVals, 2)
Loop
Dim DimY As Long, DimX As Long
DimY = 10
DimX = 10
Dim LabelArray() As Long
ReDim LabelArray(1 To DimX, 1 To DimY)
Dim src As Series, pts As Points
Set src = ActiveChart.SeriesCollection(1)
Set pts = src.Points
'Clear labels
src.HasDataLabels = False
For Counter = 1 To Range(xVals).Cells.Count
If (Range(xVals).Cells(Counter, 1).Offset(0, -1).Value = 0) Then
Exit Sub
End If
Dim xCoord As Long, yCoord As Long
xCoord = Range(xVals).Cells(Counter, 1).Value2
yCoord = Range(yVals).Cells(Counter, 1).Value2
If LabelArray(xCoord, yCoord) = 0 Then 'No overlap
LabelArray(xCoord, yCoord) = Counter
pts(Counter).HasDataLabel = True
pts(Counter).DataLabel.Text = Counter + 5
Else 'Overlap
pts(LabelArray(xCoord, yCoord)).DataLabel.Text = _
pts(LabelArray(xCoord, yCoord)).DataLabel.Text & "," & Counter + 5
End If
Next Counter
Application.ScreenUpdating = True
End Sub
Note that the code would work as long as the values for your X and Y values are ranging from 1 to 10. You could also change the upper bound by changing the value of DimX and DimY.
Additionally, I should mention that this code has limitations:
In its current version, it cannot handle whole numbers equal or smaller than 0 for the X and Y values.
The method to parse the SERIES formula is not robust to the presence of certain characters such as a comma in the sheet name (yes, that's allowed for some reason).
The way the code is specified assumes that the data series are vertically orientated. Maybe, for a more general solution, you would have to test for the orientation of the data or you could implement something using src.XValues and src.Values (for Y values) which returns arrays instead of a range.