Sub DelinkChartFromLotsOfData()
Dim nPts As Long, iPts As Long
Dim xArray As String, yArray As String
Dim xVals, yVals
Dim ChtSeries As Series
Dim iChars As Integer
Dim sChtName As String
Dim sSrsName As String
Dim iPlotOrder As Integer
''' Make sure a chart is selected
On Error Resume Next
sChtName = ActiveChart.Name
If Err.Number <> 0 Then
MsgBox "This functionality is available only for charts " _
& "or chart objects"
Exit Sub
End If
If TypeName(Selection) = "ChartObject" Then
ActiveSheet.ChartObjects(Selection.Name).Activate
End If
On Error GoTo 0
''' Loop through all series in active chart
For Each ChtSeries In ActiveChart.SeriesCollection
nPts = ChtSeries.Points.Count
xArray = ""
yArray = ""
xVals = ChtSeries.XValues
yVals = ChtSeries.Values
sSrsName = ChtSeries.Name
iPlotOrder = ChtSeries.PlotOrder
For iPts = 1 To nPts
If IsNumeric(xVals(iPts)) Then
''' shorten numbers in X array (remove excess digits)
iChars = WorksheetFunction.Max _
(InStr(CStr(xVals(iPts)), "."), 5)
xArray = xArray & Left(CStr(xVals(iPts)), iChars) & ","
Else
''' put quotes around string values
xArray = xArray & """" & xVals(iPts) & ""","
End If
''' shorten numbers in Y array (remove excess digits)
iChars = WorksheetFunction.Max _
(InStr(CStr(yVals(iPts)), "."), 5)
''' handle missing data - replace blanks and #N/A with #N/A
If IsEmpty(yVals(iPts)) Or WorksheetFunction.IsNA(yVals(iPts)) Then
yArray = yArray & "#N/A,"
Else
yArray = yArray & Left(CStr(yVals(iPts)), iChars) & ","
End If
Next
''' remove final comma
xArray = Left(xArray, Len(xArray) - 1)
yArray = Left(yArray, Len(yArray) - 1)
''' Construct the new series formula
ChtSeries.Formula = "=SERIES(""" & sSrsName & """,{" & xArray & "},{" _
& yArray & "}," & CStr(iPlotOrder) & ")"
Next
End Sub