Option Explicit

Sub RandomCustomShow()

  Dim Show() As String, TotalShows As Integer, x As Integer
  Dim pst As Presentation, SlideString() As String, Id As Integer
  Dim RandSet As Integer, TotalSetString As String, TotalSets As Integer
  Dim ShowString As String, TempArray As Variant, FinalShow() As Long
  Dim Confirm As String

  Set pst = ActivePresentation

  TotalShows = pst.SlideShowSettings.NamedSlideShows.Count
  If TotalShows = 0 Then
    MsgBox ("No Custom Shows")
    End
  End If
  
  'See if the TempShow is already in there.
  For x = 1 To TotalShows
    If pst.SlideShowSettings.NamedSlideShows(x).Name = "!!!TempShow" Then
      Confirm = MsgBox("The Tempshow already exists would you like to replace it?", vbYesNo)
      If Confirm = vbYes Then
        pst.SlideShowSettings.NamedSlideShows(x).Delete
        TotalShows = TotalShows - 1
        Exit For
      Else
        End
      End If
    End If
  Next x
  
  
  ReDim Show(1 To TotalShows) As String
  ReDim SlideString(1 To TotalShows) As String
  TotalSetString = InputBox("How long do you want the custom show?" & vbLf _
  & "Enter a number between 1 and 100")
  If TotalSetString = "" Then End
  If Not IsNumeric(TotalSetString) Then
    MsgBox "You must enter a number. Program ending"
    End
  End If
  
  TotalSets = CInt(TotalSetString)


    
  'Store the shows in an array
  For x = 1 To TotalShows
    Show(x) = pst.SlideShowSettings.NamedSlideShows(x).Name
      With pst.SlideShowSettings.NamedSlideShows(x)
        For Id = 1 To .Count
          SlideString(x) = SlideString(x) & .SlideIDs(Id) & ","
        Next Id
      End With
  Next x
  
  For x = 1 To TotalSets
  RandSet = Int(Rnd() * TotalShows) + 1 'Use + 1 because arrays start at 0
  ShowString = ShowString & SlideString(RandSet)
  Next x
  ShowString = Left(ShowString, Len(ShowString) - 1) 'Remove last comma
  
  TempArray = Split(ShowString, ",")
  ReDim FinalShow(0 To UBound(TempArray)) As Long
  'Convert the array to a useable one.
  For x = 0 To UBound(TempArray)
    FinalShow(x) = CLng(TempArray(x))
  Next x
  'Add the show to the Custom Shows List
  pst.SlideShowSettings.NamedSlideShows.Add "!!!TempShow", FinalShow
  
  Confirm = MsgBox("!!!TempShow has been created in the custom shows and can be ran now." & _
  vbLf & "Would you like to run it now?", vbYesNo)
  If Confirm = vbNo Then End
  
  With pst.SlideShowSettings
        ' change these as needed
        .ShowType = ppShowTypeSpeaker
        .LoopUntilStopped = msoTrue
        .ShowWithNarration = msoTrue
        .ShowWithAnimation = msoTrue
        .RangeType = ppShowNamedSlideShow
        .SlideShowName = "!!!TempShow"
        .Run
    End With
  
End Sub