Macro called from Excel to Open a PowerPoint Presentation, Insert a Slide, and Copy Range to Slide works sometimes, errors others

Question

Disclaimer- very new to writing VBA macros, but I have done a ton of research on here and other forums while trying to fix this error, all to no avail. Apologies if this has already been asked and answered, maybe I'm not searching correctly.

Now to the meat and potatos: I've been working on a VBA macro in Excel that will allow me to:

1. Open a new or existing PowerPoint presentation
2. Paste a value to, and activate, a specific cell, which in turn populates the spreadsheet using a vlookup formula
3. Copy the values only from the first spreadsheet to a second one and then copy the second spreadsheet
4. Make PowerPoint visible and then insert a new slide at a certain point
5. Paste the Excel data to the new slide and position accordingly.

Whenever I run the macro with the PowerPoint presentation already open, it works perfectly. If I try to do it without the presentation open, it will prompt me to select the presentation file, open the PowerPoint, run the Excel functions, but then it hangs up when I try to make PowerPoint visible, add a slide, and paste the data. At Line 57 (pptApp.Visible = msoTrue) of the code below, the macro hangs and gives me the "Run-time error '91' Object variable or With block variable not set" message. I have been banging my head against this wall, but can't seem to find my error. Any help is appreciated.

Additionally, once this is working I plan to tweak it to create and insert a total of 25 slides. If anyone has ideas or advice on how I could do that with the first slide being created and added mid deck, and the following new slides continuing after, I'd love to hear it. Thanks!!

Main Routine:

Sub Final_Copy()

Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptLayout As PowerPoint.CustomLayout
Dim pptShape As PowerPoint.Shape
Dim ws As Worksheet
Dim MyCell As Range, MyRange As Range
Dim rng As Excel.Range

Set rng = ThisWorkbook.ActiveSheet.Range("B1:I24")
Set MyRange = Sheets("Titles").Range("A2")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
Set ws = ThisWorkbook.Sheets("PBAC")

On Error Resume Next
Set pptApp = GetObject(, "PowerPoint.Application")
Err.Clear
If pptApp Is Nothing Then SelectPresentationType.Show


On Error GoTo 0

For Each MyCell In MyRange

    If MyCell.Value <> ("1100") Then
        Sheets("Titles").Select
        MyCell.Select
        Selection.Copy
        Sheets("PBAC").Select
        Sheets("PBAC").Range("B25").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Sheets("PBAC").Range("B25").Activate

        With ws.UsedRange
            .Copy
            ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count), Count:=1, Type:=xlWorksheet
            Sheets(Sheets.Count).Name = MyCell.Value
            Selection.PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Selection.PasteSpecial Paste:=xlPasteColumnWidths
            Selection.PasteSpecial Paste:=xlPasteFormats
            Application.CutCopyMode = False
            ActiveSheet.Rows("1").RowHeight = 44.25
            ActiveSheet.Rows("2").RowHeight = 34.5
            ActiveSheet.Rows("3").RowHeight = 18.75
            ActiveSheet.Rows("4").RowHeight = 31.5
            ActiveSheet.Rows("18").RowHeight = 31.5
            ActiveSheet.Rows("5:17").RowHeight = 21.75
            ActiveSheet.Rows("19:24").RowHeight = 21.75
            ActiveWindow.DisplayGridlines = False
            ActiveWindow.Zoom = 69
        End With
Set rng = ThisWorkbook.ActiveSheet.Range("B1:I24")
    pptApp.Visible = msoTrue
    pptApp.Activate
Set pptPres = pptApp.ActivePresentation
Set pptLayout = pptPres.Slides(1).CustomLayout
Set pptSlide = pptPres.Slides.AddSlide(17, pptLayout)
rng.Copy
pptSlide.Shapes.PasteSpecial ppPasteEnhancedMetafile
Set pptShape = pptSlide.Shapes(pptSlide.Shapes.Count)
With pptShape
  .LockAspectRatio = msoTrue
  .Width = 725
  .Height = 450
  .Top = 55
  .Left = 9
End With
Application.CutCopyMode = False

    End If
Next MyCell

End Sub

Code for SelectPresentationType User Form used to select Existing or New Presentation:

Private Sub Create_New_Click()

Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
    SelectPresentationType.Hide
Set pptApp = CreateObject(class:="PowerPoint.Application")
    pptApp.Visible = True
    pptApp.Activate
Set myPresentation = pptApp.Presentations.Add

End Sub

Private Sub Existing_Presentation_Click()

Dim strFilePath As String
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
    SelectPresentationType.Hide
    strFilePath = Application.GetOpenFilename
        If strFilePath = "False" Then Exit Sub
Set pptApp = New PowerPoint.Application
Set pptPres = pptApp.Presentations.Open(strFilePath)
    pptApp.Visible = True

End Sub

Answer 1

pptPres is dimmed in both your main routine and in your button click handler.

You set pptPres (the one in the click handler) to a a presentation, pptPres goes out of scope and disappears when you return from the button handler sub, the rest of your code has no reference to the presentation in ITs local copy of pptPres.

Suggestion:

Write a function that shows the Open/Save dialog box (as you're already doing), opens the presentation and returns a reference to the presentation object to your main code.