title: Excel VBA to PPT, Code Randomly Copies Same Chart Over and Over
body: <p>Good day all.  I need a pro to tell me what the heck is going on with my code.  A few things you should know that might affect outcomes:</p>
  
  <p>WIN10
  Excel 2016
  All Charts are 'Pivot Charts' no chart is connected to a pivot table or table, it connects directly to the data model.  (Chart inserted using PP Utilities).</p>
  
  <p>So the code below shows a macro telling Excel to copy a certain array of charts in different sheets, and to paste them in specific slides in PowerPoint.</p>
  
  <p>However, it seems to want to copy the same one over and over.  For example, the 2nd chart in the array....  it will copy 4 times before it gets back on track with the order I'm telling it to.... so it will copy chart "A-02" 4 times (skip the ones it was supposed to copy and paste) then resume.</p>
  
  <p>I've done lots of trial and error.  I've taken chart "A-02" out completely, but then it will just select the next one in line and copy that several times.</p>
  
  <p>I don't understand why this is happening.  I want it to copy each chart 1 time, and paste it to the designated slide once.  What gives?  </p>
  
  <pre><code>Sub SCOM_Charts()
  
  ActiveSheet.Shapes.Range(Array("Object 4")).Select
  Selection.Verb Verb:=3
  
  If Not Application.CalculationState = xlDone Then
  DoEvents
  End If
  
  Application.CalculateUntilAsyncQueriesDone
  
  Dim myPresentation As Object
  Dim mySlide As Object
  Dim PowerPointApp As Object
  Dim shp As Object
  Dim MySlideArray As Variant
  Dim MyChartArray As Variant
  Dim X As Long
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  On Error Resume Next
  
  Set PowerPointApp = GetObject(class:="PowerPoint.Application")
  
  Err.Clear
  
  If PowerPointApp Is Nothing Then
  MsgBox "PowerPoint Presentation is not open, action aborted."
  Exit Sub
  End If
  
  If Err.Number = 429 Then
  MsgBox "PowerPoint could not be found, action aborted."
  Exit Sub
  End If
  
  On Error GoTo 0
  
  PowerPointApp.ActiveWindow.Panes(2).Activate
  
  Set myPresentation = PowerPointApp.ActivePresentation
  
  MySlideArray = Array(2, 3, 4, 5, 6, 7, 8)
  
  MyChartArray = Array(Sheet2.ChartObjects("A-01"), Sheet2.ChartObjects("A- 
  02"), Sheet2.ChartObjects("A-04"), Sheet2.ChartObjects("A-07"), 
  Sheet2.ChartObjects("A-08"), Sheet1.ChartObjects("V-02"), 
  Sheet1.ChartObjects("V-01"))
  
  For X = LBound(MySlideArray) To UBound(MySlideArray)
  MyChartArray(X).Copy
  
  On Error Resume Next
  Set shp = myPresentation.Slides(MySlideArray(X)).Shapes.Paste
  Error GoTo 0
  
  With myPresentation.PageSetup
  On Error Resume Next
  shp.LinkFormat.BreakLink
  End With
  
  Next X
  
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  Application.CutCopyMode = False
  
  ThisWorkbook.Activate
  MsgBox "Export to PowerPoint complete. Note: **All slides will be lost when 
  this workbook is closed.**"
  
  End Sub
  </code></pre>