Delete everything but the title

[cwojtak]

Your Advice worked perfect! Thank you John! If interested in the overall goal -

I have about 60 Tables in Excel that I put into different powerpoints each month. All of the slides I am working with have a title, a table, and some (not all) have bullet points in text boxes. I am writing a code that allows me to highlight a table in excel, press the macro shortcut key and produce the following actions

- Delete all of the content in the selected slide excluding the title box and words in the title box
- Paste the selected table from excel into the selected slide

For reference, here is my full code. Please let me know if you have any recommendations to make it more concise!

Sub ExcelRangeToPowerPoint()

Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Slide
Dim myShape As Object


'Copy Range from Excel
  Set rng = Selection
  rng.Copy


'Create an Instance of PowerPoint
  On Error Resume Next
    
    'Is PowerPoint already opened?
      Set PowerPointApp = GetObject(class:="PowerPoint.Application")
    
    'Clear the error between errors
      Err.Clear


    'If PowerPoint is not already open then open PowerPoint
      If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
    
    'Handle if the PowerPoint Application is not found
      If Err.Number = 429 Then
        MsgBox "PowerPoint could not be found, aborting."
        Exit Sub
      End If


  On Error GoTo 0


  Application.ScreenUpdating = False
  
  Set myPresentation = PowerPointApp.ActivePresentation
  
  Set mySlide = PowerPointApp.ActiveWindow.Selection.SlideRange(1)
  
  Dim L As Long
  For L = mySlide.Shapes.Count To 1 Step -1
  If mySlide.Shapes(L).ID <> mySlide.Shapes.Title.ID Then
  mySlide.Shapes(L).Delete
  End If
  Next L


'Paste to PowerPoint and position
  mySlide.Shapes.Paste
  Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
  
    'Set position:
      myShape.Left = 66
      myShape.Top = 152


'Make PowerPoint Visible and Active
  PowerPointApp.Visible = True
  PowerPointApp.Activate


'Clear The Clipboard
  Application.CutCopyMode = False
  
End Sub