CODEWITHSUNDEEP
vbaexcelcharts
willbacker45
willbacker45

Reputation: 1

VBA to extract series name, X, and Y values from Excel Chart

I was looking for help on extracting data from an excel chart. Specifically, I need to pull series names, X, and Y values from all points on the chart. I started with the basic code from Excel but it is only giving me X values. 

Sub GetChartValues()
Dim NumberOfRows As Integer
Dim X As Object
Counter = 2

' Calculate the number of rows of data.
NumberOfRows = UBound(ActiveChart.SeriesCollection(1).Values)

Worksheets("ChartData").Cells(1, 1) = "X Values"

' Write x-axis values to worksheet.
With Worksheets("ChartData")
  .Range(.Cells(2, 1), _
  .Cells(NumberOfRows + 1, 1)) = _
  Application.Transpose(ActiveChart.SeriesCollection(1).XValues)
End With

' Loop through all series in the chart and write their values to
' the worksheet.
For Each X In ActiveChart.SeriesCollection
  Worksheets("ChartData").Cells(1, Counter) = X.Name

  With Worksheets("ChartData")
     .Range(.Cells(2, Counter), _
     .Cells(NumberOfRows + 1, Counter)) = _
     Application.Transpose(X.Values)
  End With

  Counter = Counter + 1
Next

End Sub

I need to figure out how to make this work so I can create tables of the given values. I have also attached an image of the chart I am working on. Any help would really be appreciated!

Chart Picture

Station Timetable Picture

Upvotes: 0

Views: 3967

Answers (1)

IIJHFII
IIJHFII

Reputation: 600

give this a go, make sure your chart is selected before running the code:

Sub Getting_data()

   Dim iSrs As Long
   Dim cht As Chart
   Dim srs As Series
   Dim wkst As Worksheet

   If ActiveChart Is Nothing Then Exit Sub

   Set cht = ActiveChart
   Set wkst = Worksheets.Add
   For iSrs = 1 To cht.SeriesCollection.Count
       Set srs = cht.SeriesCollection(iSrs)
       On Error Resume Next
       wkst.Cells(1, 2 * iSrs).value = srs.Name
       wkst.Cells(2, 2 * iSrs - 1).Resize(srs.Points.Count).value = _
           WorksheetFunction.Transpose(srs.XValues)
       wkst.Cells(2, 2 * iSrs).Resize(srs.Points.Count).value = _
           WorksheetFunction.Transpose(srs.Values)
   Next

End Sub

Upvotes: 1

Related Questions