Sub n()

Dim SlideNameArray1(5) As String
Dim SlideArray1(5) As Integer
Dim SlideArray2(5) As Integer
Dim SlideArray3(5) As Integer
Dim Values(4) As Integer
Dim MultiArray(1 To 6, 1 To 3) As Integer

For x = 1 To ActivePresentation.Slides.Count Step 1
With ActivePresentation.Slides(x)
    .SlideShowTransition.AdvanceOnClick = msoFalse
    .SlideShowTransition.AdvanceOnTime = msoTrue
    .SlideShowTransition.AdvanceTime = 1
    End With
Next x

'1-36

Time1 = 2
Time2 = 17

FirstSlide = 1
LastSlide = 36

'38,40,42,44

SlideArray2(1) = LastSlide + 2
SlideArray2(2) = LastSlide + 4
SlideArray2(3) = LastSlide + 6
SlideArray2(4) = LastSlide + 8

FirstSlide2 = 1
LastSlide2 = 4

'39,41,43

SlideArray3(1) = LastSlide + 3
SlideArray3(2) = LastSlide + 5
SlideArray3(3) = LastSlide + 7

FirstSlide3 = 1
LastSlide3 = 3

'1-36

For j = FirstSlide To LastSlide
RSN = Int((LastSlide - FirstSlide + 1) * Rnd + FirstSlide)
RNDTime = RND2(Time2, Time1)
With ActivePresentation.Slides(j)
    .MoveTo (RSN)
End With
Next j

'Random Number Filter

Control = 0

For j = 1 To 4
SlideArray1(j) = RND2(LastSlide, FirstSlide)
Next j

n1 = 0

If ((Ap12(SlideArray1) Or Ap13(SlideArray1) Or Ap23(SlideArray1)) Or (A1234(SlideArray1)) Or (A123(SlideArray1)) Or (A124(SlideArray1)) Or (A134(SlideArray1)) Or (A234(SlideArray1))) Then
    Control = 1
Else
    Control = 0
End If

While Control
    For j = 1 To 4
    SlideArray1(j) = RND2(LastSlide, FirstSlide)
    Next j
    If ((Ap12(SlideArray1) Or Ap13(SlideArray1) Or Ap23(SlideArray1)) Or (A1234(SlideArray1)) Or (A123(SlideArray1)) Or (A124(SlideArray1)) Or (A134(SlideArray1)) Or (A234(SlideArray1))) Then
        Control = 1
    Else
        Control = 0
    End If
     n1 = n1 + 1
Wend

For j = 1 To 4
    Values(j) = Check(SlideArray1)(j)
Next j

CheckingNumber = 0

If Values(4) <> 0 Then
CheckingNumber = 1
End If

Number1 = 1

While CheckingNumber
If (Number1 = Values(1)) Or (Number1 = Values(2)) Or (Number1 = Values(3)) Then
Number1 = Number1 + 1
End If
If (Number1 <> Values(1)) And (Number1 <> Values(2)) And (Number1 <> Values(3)) Then
SlideArray1(Values(4)) = Number1
CheckingNumber = 0
End If
Wend

'38,40,42,44

For j = FirstSlide2 To LastSlide2
RNDTime = RND2(Time2, Time1)
ActivePresentation.Slides(SlideArray1(j)).Duplicate
With ActivePresentation.Slides(SlideArray1(j))
    .SlideShowTransition.AdvanceTime = RNDTime
    .MoveTo (SlideArray2(j))
End With
    ActivePresentation.Slides(SlideArray2(j) + 1).Delete
With ActivePresentation.Slides(SlideArray1(j))
    .SlideShowTransition.AdvanceTime = RNDTime
End With
With ActivePresentation.Slides(SlideArray2(j))
    .SlideShowTransition.AdvanceTime = RNDTime
End With
Next j

'39,41,43
 
RN3 = RND2(6, 1)

MultiArray(1, 1) = 1
MultiArray(1, 2) = 2
MultiArray(1, 3) = 3

MultiArray(2, 1) = 1
MultiArray(2, 2) = 3
MultiArray(2, 3) = 2

MultiArray(3, 1) = 2
MultiArray(3, 2) = 3
MultiArray(3, 3) = 1

MultiArray(4, 1) = 2
MultiArray(4, 2) = 1
MultiArray(4, 3) = 3

MultiArray(5, 1) = 3
MultiArray(5, 2) = 1
MultiArray(5, 3) = 2

MultiArray(6, 1) = 3
MultiArray(6, 2) = 2
MultiArray(6, 3) = 1


If (MultiArray(RN3, 1) = 1) And (MultiArray(RN3, 2) = 3) And (MultiArray(RN3, 3) = 2) Then
    ActivePresentation.Slides(SlideArray3(2)).MoveTo (SlideArray3(3))
    ActivePresentation.Slides(SlideArray3(3) - 1).MoveTo (SlideArray3(2))
 
ElseIf (MultiArray(RN3, 1) = 2) And (MultiArray(RN3, 2) = 3) And (MultiArray(RN3, 3) = 1) Then
    ActivePresentation.Slides(SlideArray3(1)).MoveTo (SlideArray3(3))
    ActivePresentation.Slides(SlideArray3(2) - 1).MoveTo (SlideArray3(1))
    ActivePresentation.Slides(SlideArray3(3) - 1).MoveTo (SlideArray3(2))
    
ElseIf (MultiArray(RN3, 1) = 2) And (MultiArray(RN3, 2) = 1) And (MultiArray(RN3, 3) = 3) Then
    ActivePresentation.Slides(SlideArray3(1)).MoveTo (SlideArray3(2))
    ActivePresentation.Slides(SlideArray3(2) - 1).MoveTo (SlideArray3(1))
    
ElseIf (MultiArray(RN3, 1) = 3) And (MultiArray(RN3, 2) = 2) And (MultiArray(RN3, 3) = 1) Then
    ActivePresentation.Slides(SlideArray3(1)).MoveTo (SlideArray3(3))
    ActivePresentation.Slides(SlideArray3(3) - 1).MoveTo (SlideArray3(1))
         
ElseIf (MultiArray(RN3, 1) = 3) And (MultiArray(RN3, 2) = 1) And (MultiArray(RN3, 3) = 2) Then
    ActivePresentation.Slides(SlideArray3(1)).MoveTo (SlideArray3(2))
    ActivePresentation.Slides(SlideArray3(2) - 1).MoveTo (SlideArray3(3))
    ActivePresentation.Slides(SlideArray3(3) - 1).MoveTo (SlideArray3(1))
End If

'Start

ActivePresentation.SlideShowSettings.Run
  
End Sub

Function RND2(LastSlide, FirstSlide)
RND2 = Int((LastSlide - FirstSlide + 1) * Rnd() + FirstSlide)
End Function

Function A1234(SlideArray)
A1234 = (SlideArray(1) = SlideArray(2)) And (SlideArray(1) = SlideArray(3)) And (SlideArray(1) = SlideArray(4))
End Function

Function A123(SlideArray)
A123 = (SlideArray(1) = SlideArray(2)) And (SlideArray(2) = SlideArray(3)) And (SlideArray(1) = SlideArray(3))
End Function

Function A124(SlideArray)
A124 = (SlideArray(1) = SlideArray(2)) And (SlideArray(1) = SlideArray(4)) And (SlideArray(2) = SlideArray(4))
End Function

Function A134(SlideArray)
A134 = (SlideArray(1) = SlideArray(3)) And (SlideArray(1) = SlideArray(4)) And (SlideArray(3) = SlideArray(4))
End Function

Function A234(SlideArray)
A234 = (SlideArray(2) = SlideArray(3)) And (SlideArray(3) = SlideArray(4)) And (SlideArray(2) = SlideArray(4))
End Function

Function Ap12(SlideArray)
Ap12 = (SlideArray(1) = SlideArray(2)) And (SlideArray(3) = SlideArray(4))
End Function

Function Ap13(SlideArray)
Ap13 = (SlideArray(1) = SlideArray(3)) And (SlideArray(2) = SlideArray(4))
End Function

Function Ap23(SlideArray)
Ap23 = (SlideArray(2) = SlideArray(3)) And (SlideArray(1) = SlideArray(4))
End Function

Function Check(SlideArray)

Dim Values(4) As Integer

A12 = (SlideArray(1) = SlideArray(2))
A13 = (SlideArray(1) = SlideArray(3))
A14 = (SlideArray(1) = SlideArray(4))
A23 = (SlideArray(2) = SlideArray(3))
A24 = (SlideArray(2) = SlideArray(4))
A34 = (SlideArray(3) = SlideArray(4))

    If A12 Then
        Values(1) = SlideArray(3)
        Values(2) = SlideArray(4)
        Values(3) = SlideArray(1)
        Values(4) = 1
    ElseIf A13 Then
        Values(1) = SlideArray(2)
        Values(2) = SlideArray(4)
        Values(3) = SlideArray(1)
        Values(4) = 1
    ElseIf A14 Then
        Values(1) = SlideArray(2)
        Values(2) = SlideArray(3)
        Values(3) = SlideArray(1)
        Values(4) = 1
    ElseIf A23 Then
        Values(1) = SlideArray(1)
        Values(2) = SlideArray(4)
        Values(3) = SlideArray(2)
        Values(4) = 2
    ElseIf A24 Then
        Values(1) = SlideArray(1)
        Values(2) = SlideArray(3)
        Values(3) = SlideArray(2)
        Values(4) = 2
    ElseIf A34 Then
        Values(1) = SlideArray(1)
        Values(2) = SlideArray(2)
        Values(3) = SlideArray(1)
        Values(4) = 1
    Else
        Values(1) = 0
        Values(2) = 0
        Values(3) = 0
        Values(4) = 0
    End If
Check = Values
End Function