Skip to content

Instantly share code, notes, and snippets.

@strickc
Last active March 6, 2017 00:59
Show Gist options
  • Save strickc/13cd9083e289cb09a777bbbac3ae1ca6 to your computer and use it in GitHub Desktop.
Save strickc/13cd9083e289cb09a777bbbac3ae1ca6 to your computer and use it in GitHub Desktop.
Populate chart labels from custom data in designated column Excel VBA
Function xValRange(cForm As String) As Range
Dim chunks() As String
chunks = Split(cForm, ",")
Set xValRange = Range(chunks(UBound(chunks) - 2))
End Function
'To use:
' 1) create a chart from x/y data in columns on the spreadsheet
' 2) add custom labels for specific points in an adjacent column
' 3) select the series in the chart and run the sub AttachLabelsToPoints (Alt-F8)
Sub attachLabelsToPoints()
Dim mySeries As Series, name As String, aChart As Chart, pt As Point, xRef As Range
Dim i As Integer, offset As Integer, ldr As String, addr As String
On Error GoTo errorAttachLabelsToPoints
name = Selection.name
Set aChart = ActiveChart
Set mySeries = Selection
On Error Resume Next
offset = CStr(InputBox("Enter the label column offset in relation to the x values", "Enter Offset", "-1"))
With mySeries
On Error Resume Next
.DataLabels.Delete
On Error GoTo 0
.ApplyDataLabels
Set xRef = xValRange(.Formula)
i = 0
ldr = "='" + xRef.Worksheet.name + "'!"
For Each pt In .Points
addr = ldr + xRef.Worksheet.Cells(xRef.Row + i, xRef.Column + offset).Address(ReferenceStyle:=Application.ReferenceStyle)
pt.DataLabel.Formula = addr
i = i + 1
Next pt
End With
Exit Sub
errorAttachLabelsToPoints:
MsgBox "Error, unable to find the series to attach labels to. Please select the desired series and re-run macro."
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment