Resize Powerpoint Chart ChartData range and transfer Excel Chart data values as Array

Question

I have Clustered Bar charts created in an Excel sheet of varying ranges. I am using a Powerpoint deck as a template, consisting of a Clustered Bar chart on a slide. I am duplicating the Slide chart and tranfering each Excel Chart's SeriesCollection as an Array and trying to resize the Powerpoint Charts ChartData range to the array's ubounds.

The below code works, but the ChartData range doesn't resize and some of the data is missing. I tried clearing the ChartData range before transfering array - to clear dummy values in chart, but still it does not resize and sometimes old dummy values of chart still show.
I have also commmented the ChartData.Activate lines as it flickers the screen even after applying Application.screenupdating=false.
I had to declare the Shp as an Object and not as a Shape as strangely, it was not giving me a handle to the ChartData. Same goes for oCht, pCht and ChtData.

I am using Excel 2016 Pro (64-bit) with PowerPoint 2016 (64-bit) on a Windows 10 Enterprise (64-bit) machine. Any assistance on what or where i am doing wrong, would be most appreciated.

Dim sFormula As String
Dim rFirst As Range, rLast As Range
Dim arr
Dim oPPT As Object
Dim oPres As Object
Dim oSlide As Object
Dim oCht As ChartObject
Dim Shp As Object
Dim pCht As Object
Dim ChtData As Object 'ChartData

With shtSheetName
    For Each oCht In .ChartObjects
        With oCht.Chart
            sFormula = .SeriesCollection(1).Formula
            Set rFirst = Range(Split(sFormula, ",")(2))(1)
            sFormula = .SeriesCollection(.SeriesCollection.Count).Formula
            Set rLast = Range(Split(sFormula, ",")(2)).Item(Range(Split(sFormula, ",")(2)).Count)

            With Range(rFirst, rLast)
                arr = .Offset(0, -1).Resize(.Rows.Count + 1, .Columns.Count + 1).Value2
            End With
            With oPres
                Set oSlide = .slides("Slide0_SlideName").Duplicate
                With oSlide
                    .Select
                    .moveto oPres.slides.Count
                    For Each Shp In .Shapes
                        If Shp.HasChart = True Then
                            Set pCht = Shp.Chart
                            Set ChtData = pCht.ChartData
                            With ChtData
                                .Activate
                                .Workbook.Application.WindowState = -4140
                   .Workbook.Sheets("PTSht").UsedRange.Offset(1, 0).ClearContents
                   .Workbook.Sheets("PTSht").UsedRange.Offset(1, 0).Resize(UBound(arr, 1), UBound(arr, 2)).Value2 = arr
                                pCht.SetSourceData .Workbook.Sheets("PTSht").UsedRange.Resize(UBound(arr, 1), UBound(arr, 2)).Address(, , , External:=True)   'EDIT as per Dhirendra Kumar's solution
                                .Workbook.Close
                            End With
                            Exit For
                        End If
                    Next Shp
                End With
            End With
        End With
    Next oCht
End With
...

Dhirendra Kumar Dhirendra Kumar · Accepted Answer · 2019-10-30T10:24:07

You may try following code to before closing the chart data sheet to refresh the data range for chart:

pcht.SetSourceData ChtData.Workbook.Sheets(1).UsedRange.Address(External:=True)

Resize Powerpoint Chart ChartData range and transfer Excel Chart data values as Array

1 Answers