Option Explicit

Dim dt As Date

Sub Create_Random()
' ZVI:2024-04-05 https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&TID=164251
  
  Const TimeLimit = "00:00:15" ' "hh:mm:ss"
  
  Dim a(), b()
  
  If dt > 0 Then
    MsgBox "Game is running, use Stop", vbExclamation, "Restart is blocked"
    Exit Sub
  End If
 
  ' Main
  With Лист1.Range("A1:B1").CurrentRegion.Resize(, 3)
    a() = .Value
    With .Columns(3)
      .Formula = "=RAND()"
      .Value = .Value
    End With
    .Sort .Cells(3), xlAscending, Header:=xlYes
    b() = .Value
    .Value = a()
  End With
  
  ' Write result
  Лист2.UsedRange.Offset(1).ClearContents
  Лист2.Range("A1:B1").Resize(UBound(a)).Value = b()
  
  ' Reset UsedRange
  With Лист1.UsedRange: End With
  With Лист2.UsedRange: End With
  
  ' Charge stop timer
  dt = Now + TimeValue(TimeLimit)
  Application.OnTime dt, "StopTheGame"
  
End Sub

Sub StopTheGame()
  If dt > 0 Then
    Application.OnTime Now, "Auto_Close"
    MsgBox "Game is over!", vbInformation, "Game Timer"
  End If
  Лист2.UsedRange.Offset(1).ClearContents
End Sub

Private Sub Auto_Close()
  On Error Resume Next
  If dt > 0 Then Application.OnTime EarliestTime:=dt, Procedure:="StopTheGame", Schedule:=False
  dt = 0
End Sub