Problem
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
Solution
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
-
do not use
Interger
in VBA – https://stackoverflow.com/questions/26409117/why-use-integer-instead-of-long -
do not use variable names like
a
,z
,x
, but give them some meaningful names. E.g.x
can berow
orrows
, thus the code would be easier to get.
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