Extract data labels from a chart in PowerPoint to Excel

Would like to check if anyone here is able to simplify the following code. What it does: Extract data labels value from a chart in powerpoint to excel.

Sub Extract_Datalabels3()
'Goal: To extract datalabels of Chart's series collection and write to excel
'Working

Dim sh As Shape
Dim sld As slide
Dim chtnow As Chart

Dim x As Integer
Dim z As Integer

Dim xlApp As New Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim xlworksheet As Excel.Worksheet

Set xlWorkbook = xlApp.Workbooks.Add
Set xlworksheet = xlWorkbook.Worksheets.Add
xlApp.Visible = True

Set chtnow = ActiveWindow.Selection.ShapeRange(1).Chart

z = ActiveWindow.Selection.ShapeRange(1).Chart.SeriesCollection(1).DataLabels.Count

For x = 1 To z
xlWorkbook.Sheets(1).Range("A" & x).Value = chtnow.SeriesCollection(1).DataLabels(x).Text
Next

For x = 1 To z
xlWorkbook.Sheets(1).Range("B" & x).Value = chtnow.SeriesCollection(2).DataLabels(x).Text
Next

For x = 1 To z
xlWorkbook.Sheets(1).Range("C" & x).Value = chtnow.SeriesCollection(3).DataLabels(x).Text
Next

For x = 1 To z
xlWorkbook.Sheets(1).Range("D" & x).Value = chtnow.SeriesCollection(4).DataLabels(x).Text
Next

For x = 1 To z
xlWorkbook.Sheets(1).Range("E" & x).Value = chtnow.SeriesCollection(5).DataLabels(x).Text
Next

For x = 1 To z
xlWorkbook.Sheets(1).Range("F" & x).Value = chtnow.SeriesCollection(6).DataLabels(x).Text
Next

For x = 1 To z
xlWorkbook.Sheets(1).Range("G" & x).Value = chtnow.SeriesCollection(7).DataLabels(x).Text
Next

For x = 1 To z
xlWorkbook.Sheets(1).Range("H" & x).Value = chtnow.SeriesCollection(8).DataLabels(x).Text
Next

For x = 1 To z
xlWorkbook.Sheets(1).Range("I" & x).Value = chtnow.SeriesCollection(9).DataLabels(x).Text
Next

For x = 1 To z
xlWorkbook.Sheets(1).Range("J" & x).Value = chtnow.SeriesCollection(10).DataLabels(x).Text
Next

End Sub

• Welcome to Code Review. The current question title, which states your concerns about the code, applies to too many questions on this site to be useful. The site standard is for the title to simply state the task accomplished by the code. Please see How to Ask for examples, and revise the title accordingly. Also, you could add a little bit more detail how the extracted data should get represented. – Zeta Jun 8 '18 at 7:38

Would this work instead of all the loops:

For a = 1 To 10
For x = 1 To z
xlWorkbook.Sheets(1).Cells(x, a) = chtnow.SeriesCollection(a).DataLabels(x).Text
Next
Next a

• Thanks Vityata for getting me to the right direction. This works, I just changed .Cells(x,1) to .Cells(x,a) so that it will write on the next column in excel instead of overwriting on column 1 as it loop through the series collection. – Gerald Tow Jun 8 '18 at 9:53
• @GeraldTow - you are welcome. – Vityata Jun 8 '18 at 9:58

Even better than @Vityata's answer is to extract the labels into an array, then dump the array all at once into the worksheet.

Note I'm using better variable names.

Dim OutputArray() As Variant
Redim OutputArray(1 To PointCount, 1 To SeriesCount)
For PointIndex = 1 To PointCount
For SeriesIndex = 1 To SeriesCount
OutputArray(PointIndex, SeriesIndex) = chtnow.SeriesCollection(SeriesIndex).DataLabels(PointIndex).Text
Next
Next
xlWorkbook.Worksheets(1).Range("A1").Resize(PointIndex, SeriesIndex).Value = OutputArray