VBA Code Run Time Error on Excel to Powerpoint

Okay. i have been using the attached code for some time without issues in my files. However, within the past few days, I have been getting a run time error that is very random in its appearance. The code below is simplified to create two slides in PowerPoint, where one Excel table becomes one PowerPoint slide upon running the macro. I repeat it several times to create approximately 8 slides with various sizing requirements. The error I receive appears at random, and sometimes not at all. Sometimes after slide 1, sometime after slide 6, and not always. Any guidance on fixing this issue, or simplifying the code would be appreciated.

ERROR MESSAGE RECEIVED:
Run-time error -2147188160 (80048240)
shapes.pastespecial invalid request. the specified data type is unavailable

The Debug option points me to this every time it happens, not sure it is the culprit though: mySlide.Shapes.PasteSpecial DataType:=2

That issue doesn't make sense to me, since sometimes it creates slides using the same requirements, and randomly stops. I don't know if I need to slow the slide creation process down with some kind of wait period between each slide creation, or prompt PowerPoint to remain active and visible, or it is something else that is causing this issue.

I am at my wits end trying to correct this. This is occurring in Excel '16 to PowerPoint '16

Code:

---

---

Code:

---

Sub PowerPt_ReviewDoc()


' PURPOSE: CREATE REVIEW PACKET


Dim NewName As String
Dim fpath As String
Dim nm As Name


    'INPUT NAME BOX FOR NEW FILE
    NewName = InputBox("REQUIRED NAMING FORMAT:" & vbCr & _
    " " & vbCr & _
    "<>_<>_YYYY.MM.DD_v#_Review Doc" & vbCr & _
    " " & vbCr & _
    "EX: GBR Inc_006410000027sf7_2018.09.01_ v2.0_Review Doc " & vbCr & _
    " " & vbCr & _
    "Adjust Input Box as needed, based on Naming Requirements demonstrated above:", "Name Review Doc File", Range("Title_Review Doc").Value)
    If NewName = vbNullString Then Exit Sub
   
    'MESSAGE BOX TO CREATE NEW FILE
    If MsgBox("New Review slides will be Saved in Same Location as Your Current Tool." & vbCr & _
    "Slide details will be pasted as objects. All formulas/links removed." & vbCr & _
    " " & vbCr & _
    "(May Require 1-2 Minutes to complete - Remain Patient)" _
    , vbYesNo, "Create Compact Dash Slide?") = vbNo Then Exit Sub


Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShapeRange As Object


If ActiveWorkbook.Name <> ThisWorkbook.Name Then End


'CREATE POWERPOINT INSTANCE
  On Error Resume Next
   
    'POWERPOINT OPEN?
      Set PowerPointApp = GetObject(class:="PowerPoint.Application")
   
    'CLEAR ALL ERRORS
      Err.Clear


    'OPEN POWERPOINT, IF NOT
      If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
   
    'PROCESS IF POWERPOINT NOT AVAILABLE
      If Err.Number = 429 Then
        MsgBox "PowerPoint could not be found, aborting."
        Exit Sub
      End If


  On Error GoTo 0
 
'MAKE POWERPOINT VISIBLE AND ACTIVE
  PowerPointApp.Visible = True
  PowerPointApp.Activate
   
'CREATE NEW PRESENTATION
  Set myPresentation = PowerPointApp.Presentations.Add
  myPresentation.PageSetup.SlideSize = 2


'CREATE NEW PRESENTATION SLIDE: 11 = ppLayoutTitleOnly
  Set mySlide = myPresentation.slides.Add(1, 11)


'COPY EXCEL RANGE
  Range("Compact Review").Copy


'PASTE TO POWERPOINT SLIDE, SET TYPE 2 = ppPasteEnhancedMetafile AND POSITION 1 = ppAlignLeft
  mySlide.Shapes.PasteSpecial DataType:=2
  Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)
 
      myShapeRange.Left = 35
      myShapeRange.Top = 75
      myShapeRange.ScaleHeight 1.05, msoFalse
      myShapeRange.ScaleWidth 1.3, msoFalse
   
      mySlide.Shapes.Title.TextFrame.TextRange.Characters.Text = "Financial Analysis - Compact Review"
      mySlide.Shapes.Title.TextFrame.TextRange.Characters.Font.Name = "Arial"
      mySlide.Shapes.Title.TextFrame.TextRange.Characters.Font.Size = 22
      mySlide.Shapes.Title.TextFrame.TextRange.Characters.Font.Bold = True
      mySlide.Shapes.Title.ScaleHeight 0.3, msoFalse
      mySlide.Shapes.Title.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = 1
   
'CLEAR CLIPBOARD
  Application.CutCopyMode = False



'CREATE NEW PRESENTATION SLIDE: 11 = ppLayoutTitleOnly
  Set mySlide = myPresentation.slides.Add(2, 11)


'COPY EXCEL RANGE
  Range("Detail Review").Copy


'PASTE TO POWERPOINT SLIDE, SET TYPE 2 = ppPasteEnhancedMetafile AND POSITION 1 = ppAlignLeft
  mySlide.Shapes.PasteSpecial DataType:=2
  Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)
 
      myShapeRange.Left = 35
      myShapeRange.Top = 65
      myShapeRange.ScaleHeight 0.9, msoFalse
      myShapeRange.ScaleWidth 1.15, msoFalse
   
      mySlide.Shapes.Title.TextFrame.TextRange.Characters.Text = "Financial Analysis - Detailed Review"
      mySlide.Shapes.Title.TextFrame.TextRange.Characters.Font.Name = "Arial"
      mySlide.Shapes.Title.TextFrame.TextRange.Characters.Font.Size = 22
      mySlide.Shapes.Title.TextFrame.TextRange.Characters.Font.Bold = True
      mySlide.Shapes.Title.ScaleHeight 0.3, msoFalse
      mySlide.Shapes.Title.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = 1
   
'CLEAR CLIPBOARD
  Application.CutCopyMode = False



    'SAVE WITH NEW NAME AT FILE PATH OF ORGINIAL SOURCE
    fpath = ThisWorkbook.Path & ""
    PowerPointApp.activepresentation.SaveAs Filename:=fpath & NewName & ".pptx"


    'PROMPT USER OF FILE CREATION AND REVIEW
    MsgBox "Review Slides of the tool have been generated. " & vbCr & _
    "Slides may require resizing due to source file formatting. " & vbCr & _
    "Please review/adjust slides for fit, before distribution.", vbOKOnly


End Sub



---

Any assistance solving this issue would be greatly appreciated.