Option Explicit
Option Compare Binary
Option Base 1

Public Type TRIAL
    nKEYS As Long
    nITS As Integer
    PT As Long
    TT As Long
    ST As Long
End Type

Public Const RAD = 1
Public Const TQK = 2
Public Const QUI = 3
Public Const MER = 4
Public Const HEA = 5
Public Const COM = 6
Public Const SHE = 7
Public Const INS = 8
Public Const SEL = 9

Public Const LNG = 1
Public Const DBL = 2
Public Const STR = 3

Public Const MinDbl = -1.7976931348623E+308
Public Const MaxDbl = 1.7976931348623E+308

Public Const MinLng = -2147483647
Public Const MaxLng = 2147483647

Public Const MinStr = "                           "
Public Const MaxStr = "???????????????"

Public TIMES(LNG To STR, RAD To SEL, 1 To 8) As TRIAL

Public L0() As Long         'buffer for unsorted longs
Public L1() As Long         'buffer for sorted longs
Public L2() As Long         'extra buffer used by MergeSort

Public D() As Double        'buffer for unsorted doubles
Public pD0() As Long        'buffer for unsorted pointers to doubles

Public S() As String        'buffer for unsorted strings
Public pS0() As Long       'buffer for unsorted pointers to strings

Public B() As Byte           'buffers used by TernaryQuickSort & MSDRadixSort
Public pB() As Long

Public P() As Long         'buffer used for sorted pointers

Public RAW_LNGS As Range
Public SORTED_LNGS As Range

Public RAW_DBLS As Range
Public SORTED_DBLS As Range

Public RAW_STRS As Range
Public SORTED_STRS As Range

Public RESULTS As Range

Public NAMES
Public ROW As Integer

Sub TrySorts()
    Dim NK
    Dim ITS
    Dim ITS2
    Dim LEVEL As Integer
    Dim SORT As Integer
    Dim nKEYS As Long
    Dim nITS As Integer
    Dim nITS2 As Integer
    Dim T As Long
    Dim tL As Long
    Dim tD As Long
    Dim tS As Long
    Dim tB As Long
    Dim tL2 As Long
    Dim tD2 As Long
    Dim tS2 As Long
    Dim I As Integer
    
    NK = Array(150, 500, 1500, 5000, 15000, 50000, 150000, 500000)
    ITS = Array(3000, 1000, 300, 100, 30, 10, 3, 1)
    ITS2 = Array(2000, 200, 20, 2, 0, 0, 0, 0)
    NAMES = Array("RadixSort", "TernQuickSort", "QuickSort", "MergeSort", "HeapSort", "CombSort", "ShellSort", "InsertionSort", "SelectionSort")
    
    Say "Setting up ranges."
    Set RAW_LNGS = Cells(2, 1).Resize(50, 1)
    Set SORTED_LNGS = Cells(2, 2).Resize(50, 1)
    Set RAW_DBLS = Cells(2, 3).Resize(50, 1)
    Set SORTED_DBLS = Cells(2, 4).Resize(50, 1)
    Set RAW_STRS = Cells(2, 5).Resize(50, 1)
    Set SORTED_STRS = Cells(2, 6).Resize(50, 1)
    Set RESULTS = Cells(2, 8).Resize(1000, 8)
    
    RAW_LNGS.Clear
    SORTED_LNGS.Clear
    RAW_DBLS.Clear
    SORTED_DBLS.Clear
    RAW_STRS.Clear
    SORTED_STRS.Clear
    RESULTS.Clear
    
    Cells(1, 1).Value = "raw lngs"
    Cells(1, 2).Value = "sorted lngs"
    Cells(1, 3).Value = "raw dbls"
    Cells(1, 4).Value = "sorted dbls"
    Cells(1, 5).Value = "raw strs"
    Cells(1, 6).Value = "sorted strs"
    
    Cells(1, 8).Value = "sort"
    Cells(1, 9).Value = "type"
    Cells(1, 10).Value = "# of keys"
    Cells(1, 11).Value = "repeats"
    Cells(1, 12).Value = "prep time"
    Cells(1, 13).Value = "total time"
    Cells(1, 14).Value = "sort time"
    Cells(1, 15).Value = "time/rep"
    
    Say "Dimensioning arrays."
    ReDim L0(0 To 500001)
    ReDim L1(0 To 500001)
    ReDim L2(0 To 500001)
    
    ReDim D(0 To 500001)
    ReDim pD0(0 To 500001)
    
    ReDim S(0 To 500001)
    ReDim pS0(0 To 500001)
    
    ReDim B(0 To 5000001)
    ReDim pB(0 To 500001)
    
    ReDim P(0 To 500001)
    
    ROW = 1
    For LEVEL = 4 To 8
        Say "Level " & CStr(LEVEL)
        nKEYS = CLng(NK(LEVEL))
        nITS = CInt(ITS(LEVEL))
        nITS2 = CInt(ITS2(LEVEL))
        
        Say "Measuring long prep times."
        GetRndLngs nKEYS, L0
        ListLngs RAW_LNGS, L0, 50
        ACopyL 1, nKEYS, L0, L1
        T = Timer
        For I = 1 To nITS
            ACopyL 1, nKEYS, L0, L1
        Next I
        tL = Timer - T
        T = Timer
        For I = 1 To nITS2
            ACopyL 1, nKEYS, L0, L1
        Next I
        tL2 = Timer - T
        
        Say "Measuring double prep times."
        GetRndDbls nKEYS, D, pD0
        pListDbls RAW_DBLS, D, pD0, 50
        ACopyL 1, nKEYS, pD0, P
        T = Timer
        For I = 1 To nITS
            ACopyL 1, nKEYS, pD0, P
        Next I
        tD = Timer - T
        T = Timer
        For I = 1 To nITS2
            ACopyL 1, nKEYS, pD0, P
        Next I
        tD2 = Timer - T
        
        Say "Measuring string prep times."
        GetRndStrs nKEYS, 10, S, pS0
        pListStrs RAW_STRS, S, pS0, 50
        ACopyL 1, nKEYS, pS0, P
        T = Timer
        For I = 1 To nITS
            ACopyL 1, nKEYS, pS0, P
        Next I
        tS = Timer - T
        T = Timer
        For I = 1 To nITS2
            ACopyL 1, nKEYS, pS0, P
        Next I
        tS2 = Timer - T
        Strs2Bytes S, 1, nKEYS, B, pB
        T = Timer
        For I = 1 To nITS
            Strs2Bytes S, 1, nKEYS, B, pB
        Next I
        tB = Timer - T
        
        For SORT = RAD To SEL
            Select Case SORT
                Case RAD
                    RunSortB RAD, LEVEL, nKEYS, nITS, tB
                Case TQK
                    RunSortB TQK, LEVEL, nKEYS, nITS, tB
                Case QUI
                    RunSortL QUI, LEVEL, nKEYS, nITS, tL
                    RunSortD QUI, LEVEL, nKEYS, nITS, tD
                    RunSortS QUI, LEVEL, nKEYS, nITS, tS
                Case MER
                    RunSortL MER, LEVEL, nKEYS, nITS, tL
                    RunSortD MER, LEVEL, nKEYS, nITS, tD
                    RunSortS MER, LEVEL, nKEYS, nITS, tS
                Case HEA
                    RunSortL HEA, LEVEL, nKEYS, nITS, tL
                    RunSortD HEA, LEVEL, nKEYS, nITS, tD
                    RunSortS HEA, LEVEL, nKEYS, nITS, tS
                Case COM
                    RunSortL COM, LEVEL, nKEYS, nITS, tL
                    RunSortD COM, LEVEL, nKEYS, nITS, tD
                    RunSortS COM, LEVEL, nKEYS, nITS, tS
                Case SHE
                    RunSortL SHE, LEVEL, nKEYS, nITS, tL
                    RunSortD SHE, LEVEL, nKEYS, nITS, tD
                    RunSortS SHE, LEVEL, nKEYS, nITS, tS
                Case INS
                    If LEVEL < 5 Then
                        RunSortL INS, LEVEL, nKEYS, nITS2, tL2
                        RunSortD INS, LEVEL, nKEYS, nITS2, tD2
                        RunSortS INS, LEVEL, nKEYS, nITS2, tS2
                    End If
                Case SEL
                    If LEVEL < 5 Then
                        RunSortL SEL, LEVEL, nKEYS, nITS2, tL2
                        RunSortD SEL, LEVEL, nKEYS, nITS2, tD2
                        RunSortS SEL, LEVEL, nKEYS, nITS2, tS2
                    End If
            End Select
            Cells(2, 1).Resize(1000, 15).Select
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
            Cells(ROW, 1).Select
        Next SORT
        ROW = ROW + 1
        Say "Waiting for possible break."
        Beep
        WaitFor 5
     Next LEVEL
End Sub

Sub WaitFor(NSECS As Long)
    Dim TZERO As Long
            
    TZERO = Timer
    Do While Timer < TZERO + NSECS
        DoEvents
    Loop
End Sub

Sub RunSortL(SORT As Integer, LEVEL As Integer, nKEYS As Long, nITS As Integer, PT As Long)
    Dim T As Long
    Dim I As Integer
    
    SORTED_LNGS.Clear
    Say NAMES(SORT) & " longs"
    
    Select Case SORT
        Case INS
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, L0, L1
                InsertL 1, nKEYS, L1
            Next I
        Case SEL
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, L0, L1
                SelectionSortL 1, nKEYS, L1
            Next I
        Case SHE
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, L0, L1
                ShellSortL 1, nKEYS, L1
            Next I
        Case COM
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, L0, L1
                CombSortL 1, nKEYS, L1
            Next I
        Case HEA
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, L0, L1
                HeapSortL 1, nKEYS, L1
            Next I
        Case MER
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, L0, L1
                MergeSortL 1, nKEYS, L1, L2
            Next I
        Case QUI
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, L0, L1
                QuickSortL 1, nKEYS, L1
            Next I
    End Select
    
    With TIMES(LNG, SORT, LEVEL)
        .nKEYS = nKEYS
        .nITS = nITS
        .PT = PT
        .TT = Timer - T
        .ST = .TT - .PT
        ListLngs SORTED_LNGS, L1, 50
        RESULTS(ROW, 1).Value = NAMES(SORT)
        RESULTS(ROW, 2).Value = "long"
        RESULTS(ROW, 3).Value = nKEYS
        RESULTS(ROW, 4).Value = nITS
        RESULTS(ROW, 5).Value = .PT
        RESULTS(ROW, 6).Value = .TT
        RESULTS(ROW, 7).Value = .ST
        RESULTS(ROW, 8).Value = CDbl(.ST) / nITS
    End With
    ROW = ROW + 1
End Sub

Sub RunSortD(SORT As Integer, LEVEL As Integer, nKEYS As Long, nITS As Integer, PT As Long)
    Dim T As Long
    Dim I As Integer
    
    SORTED_DBLS.Clear
    Say NAMES(SORT) & " doubles"
    
    Select Case SORT
        Case INS
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, pD0, P
                pInsertD 1, nKEYS, D, P
            Next I
        Case SEL
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, pD0, P
                pSelectionSortD 1, nKEYS, D, P
            Next I
        Case SHE
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, pD0, P
                pShellSortD 1, nKEYS, D, P
            Next I
        Case COM
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, pD0, P
                pCombSortD 1, nKEYS, D, P
            Next I
        Case HEA
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, pD0, P
                pHeapSortD 1, nKEYS, D, P
            Next I
        Case MER
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, pD0, P
                pMergeSortD 1, nKEYS, D, P, L2
            Next I
        Case QUI
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, pD0, P
                pQuickSortD 1, nKEYS, D, P
            Next I
    End Select
    
    With TIMES(DBL, SORT, LEVEL)
        .nKEYS = nKEYS
        .nITS = nITS
        .PT = PT
        .TT = Timer - T
        .ST = .TT - .PT
        pListDbls SORTED_DBLS, D, P, 50
        RESULTS(ROW, 1).Value = NAMES(SORT)
        RESULTS(ROW, 2).Value = "double"
        RESULTS(ROW, 3).Value = nKEYS
        RESULTS(ROW, 4).Value = nITS
        RESULTS(ROW, 5).Value = .PT
        RESULTS(ROW, 6).Value = .TT
        RESULTS(ROW, 7).Value = .ST
        RESULTS(ROW, 8).Value = CDbl(.ST) / nITS
    End With
    ROW = ROW + 1
End Sub

Sub RunSortS(SORT As Integer, LEVEL As Integer, nKEYS As Long, nITS As Integer, PT As Long)
    Dim T As Long
    Dim I As Integer
    
    SORTED_STRS.Clear
    Say NAMES(SORT) & " strings"
    
    Select Case SORT
        Case INS
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, pS0, P
                pInsertS 1, nKEYS, S, P
            Next I
        Case SEL
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, pS0, P
                pSelectionSortS 1, nKEYS, S, P
            Next I
        Case SHE
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, pS0, P
                pShellSortS 1, nKEYS, S, P
            Next I
        Case COM
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, pS0, P
                pCombSortS 1, nKEYS, S, P
            Next I
        Case HEA
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, pS0, P
                pHeapSortS 1, nKEYS, S, P
            Next I
        Case MER
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, pS0, P
                pMergeSortS 1, nKEYS, S, P, L2
            Next I
        Case QUI
            T = Timer
            For I = 1 To nITS
                ACopyL 1, nKEYS, pS0, P
                pQuickSortS 1, nKEYS, S, P
            Next I
    End Select
    
    With TIMES(DBL, SORT, LEVEL)
        .nKEYS = nKEYS
        .nITS = nITS
        .PT = PT
        .TT = Timer - T
        .ST = .TT - .PT
        pListStrs SORTED_STRS, S, P, 50
        RESULTS(ROW, 1).Value = NAMES(SORT)
        RESULTS(ROW, 2).Value = "string"
        RESULTS(ROW, 3).Value = nKEYS
        RESULTS(ROW, 4).Value = nITS
        RESULTS(ROW, 5).Value = .PT
        RESULTS(ROW, 6).Value = .TT
        RESULTS(ROW, 7).Value = .ST
        RESULTS(ROW, 8).Value = CDbl(.ST) / nITS
    End With
    ROW = ROW + 1
End Sub

Sub RunSortB(SORT As Integer, LEVEL As Integer, nKEYS As Long, nITS As Integer, PT As Long)
    Dim T As Long
    Dim I As Integer
    
    SORTED_STRS.Clear
    Say NAMES(SORT) & " strings"
    
    Select Case SORT
        Case RAD
            T = Timer
            For I = 1 To nITS
                Strs2Bytes S, 1, nKEYS, B, pB
                pRadixSortS B, pB, nKEYS
            Next I
        Case TQK
            T = Timer
            For I = 1 To nITS
                Strs2Bytes S, 1, nKEYS, B, pB
                pTernaryQuickSortS 1, nKEYS, B, pB
            Next I
    End Select
    
    With TIMES(STR, SORT, LEVEL)
        .nKEYS = nKEYS
        .nITS = nITS
        .PT = PT
        .TT = Timer - T
        .ST = .TT - .PT
        pListBytes SORTED_STRS, B, pB, nKEYS, 50
        RESULTS(ROW, 1).Value = NAMES(SORT)
        RESULTS(ROW, 2).Value = "string"
        RESULTS(ROW, 3).Value = nKEYS
        RESULTS(ROW, 4).Value = nITS
        RESULTS(ROW, 5).Value = .PT
        RESULTS(ROW, 6).Value = .TT
        RESULTS(ROW, 7).Value = .ST
        RESULTS(ROW, 8).Value = CDbl(.ST) / nITS
    End With
    ROW = ROW + 1
End Sub

Sub Say(S As String)
    Application.DisplayStatusBar = True
    Application.StatusBar = S
End Sub

Sub LoadLngs(BLK As Range, A() As Long, N As Long)
    Dim ROW As Long
    Dim COL As Integer
    Dim V
    
    N = BLK.Columns.COUNT * BLK.Rows.COUNT
    If UBound(A) < N + 1 Then ReDim A(0 To N + 1)
    A(0) = MinLng
    N = 1
    For COL = 1 To BLK.Columns.COUNT
        For ROW = 1 To BLK.Rows.COUNT
            V = BLK(ROW, COL).Value
            If Not IsEmpty(V) Then
                A(N) = CLng(V)
                N = N + 1
                If N Mod 10000 = 0 Then Say CStr(N) & " longs loaded"
            End If
        Next ROW
    Next COL
    A(N) = MaxLng
End Sub

Sub ListLngs(BLK As Range, A() As Long, ByVal N As Long, Optional MAXROWS As Long = 50000, Optional MAXCOLS As Integer = 1)
    Dim I As Long
    Dim ROW As Long
    Dim COL As Integer
    
    For I = 1 To N
        ROW = I Mod MAXROWS
        If ROW = 0 Then
            ROW = MAXROWS
        ElseIf ROW = 1 Then
            COL = COL + 1
            If COL > MAXCOLS Then Exit Sub
        End If
        BLK(ROW, COL).Value = A(I)
        If I Mod 10000 = 0 Then Say CStr(I) & " longs listed"
    Next I
End Sub

Sub LoadDbls(BLK As Range, A() As Double, P() As Long, N As Long)
    Dim ROW As Long
    Dim COL As Integer
    Dim V
    
    N = BLK.Columns.COUNT * BLK.Rows.COUNT
    If UBound(A) < N + 1 Then ReDim A(0 To N + 1)
    A(0) = MinDbl
    N = 1
    For COL = 1 To BLK.Columns.COUNT
        For ROW = 1 To BLK.Rows.COUNT
            V = BLK(ROW, COL).Value
            If Not IsEmpty(V) Then
                A(N) = CDbl(V)
                P(N) = N
                N = N + 1
                If N Mod 10000 = 0 Then Say CStr(N) & " doubles loaded"
            End If
        Next ROW
    Next COL
    A(N) = MaxDbl
End Sub

Sub pListDbls(BLK As Range, A() As Double, P() As Long, ByVal N As Long, Optional MAXROWS As Long = 50000, Optional MAXCOLS As Integer = 1)
    Dim I As Long
    Dim ROW As Long
    Dim COL As Integer
    
    For I = 1 To N
        ROW = I Mod MAXROWS
        If ROW = 0 Then
            ROW = MAXROWS
        ElseIf ROW = 1 Then
            COL = COL + 1
            If COL > MAXCOLS Then Exit Sub
        End If
        BLK(ROW, COL).Value = A(P(I))
        If I Mod 10000 = 0 Then Say CStr(I) & " doubles listed"
    Next I
End Sub

Sub LoadStrs(BLK As Range, A() As String, P() As Long, N As Long)
    Dim ROW As Long
    Dim COL As Integer
    Dim V
    
    N = BLK.Columns.COUNT * BLK.Rows.COUNT
    If UBound(A) < N + 1 Then ReDim A(0 To N + 1)
    A(0) = MinStr
    N = 1
    For COL = 1 To BLK.Columns.COUNT
        For ROW = 1 To BLK.Rows.COUNT
            V = BLK(ROW, COL).Value
            If Not IsEmpty(V) Then
                A(N) = CStr(V)
                P(N) = N
                N = N + 1
                If N Mod 10000 = 0 Then Say CStr(N) & " strings loaded"
            End If
        Next ROW
    Next COL
    A(N) = MaxStr
End Sub

Sub pListStrs(BLK As Range, A() As String, P() As Long, ByVal N As Long, Optional MAXROWS As Long = 50000, Optional MAXCOLS As Integer = 1)
    Dim I As Long
    Dim ROW As Long
    Dim COL As Integer
    
    For I = 1 To N
        ROW = I Mod MAXROWS
        If ROW = 0 Then
            ROW = MAXROWS
        ElseIf ROW = 1 Then
            COL = COL + 1
            If COL > MAXCOLS Then Exit Sub
        End If
        BLK(ROW, COL).Value = A(P(I))
        If I Mod 10000 = 0 Then Say CStr(I) & " strings listed"
    Next I
End Sub

Sub pListBytes(BLK As Range, B() As Byte, P() As Long, ByVal N As Long, Optional MAXROWS As Long = 50000, Optional MAXCOLS As Integer = 1)
    Dim I As Long
    Dim ROW As Long
    Dim COL As Integer
    Dim J As Long
    Dim S As String
    
    For I = 1 To N
        ROW = I Mod MAXROWS
        If ROW = 0 Then
            ROW = MAXROWS
        ElseIf ROW = 1 Then
            COL = COL + 1
            If COL > MAXCOLS Then Exit Sub
        End If
        S = ""
        J = P(I)
        Do
            S = S & Chr(B(J))
            J = J + 1
        Loop Until B(J) = 0
        BLK(ROW, COL).Value = S
        If I Mod 10000 = 0 Then Say CStr(I) & " strings listed"
    Next I
End Sub

Sub Strs2Bytes(A() As String, L As Long, R As Long, B() As Byte, P() As Long)
    Dim StrNum As Long
    Dim nPtrs As Long
    Dim nBytes As Long
    Dim DEPTH As Integer
    
    nBytes = 0
    nPtrs = 0
    For StrNum = L To R
        nBytes = nBytes + Strings.Len(A(StrNum)) + 1
        nPtrs = nPtrs + 1
    Next StrNum
    ReDim B(1 To nBytes)
    ReDim P(1 To nPtrs)
    
    nPtrs = 1
    nBytes = 1
    For StrNum = L To R
        P(nPtrs) = nBytes
        For DEPTH = 1 To Strings.Len(A(StrNum))
            B(nBytes) = Asc(Strings.MID(A(StrNum), DEPTH, 1))
            nBytes = nBytes + 1
        Next DEPTH
        B(nBytes) = 0
        nBytes = nBytes + 1
        nPtrs = nPtrs + 1
        If StrNum Mod 10000 = 0 Then Say CStr(StrNum) & " converted"
    Next StrNum
End Sub

Sub ACopyS(L As Long, R As Long, A() As String, B() As String)
    Dim I As Long
    
    For I = L To R
        B(I) = A(I)
    Next I
End Sub

Sub ACopyL(L As Long, R As Long, A() As Long, B() As Long)
    Dim I As Long
    
    For I = L To R
        B(I) = A(I)
    Next I
End Sub

Sub ACopyD(L As Long, R As Long, A() As Double, B() As Double)
    Dim I As Long
    
    For I = L To R
        B(I) = A(I)
    Next I
End Sub

Sub GetRndStrs(CNT As Long, LENGTH As Integer, A() As String, P() As Long)
    Dim I As Long
    Dim J As Integer
    Dim C As Integer
    Dim S As String
    
    Randomize
    ReDim A(0 To CNT + 1)
    For I = 1 To CNT
        S = ""
        For J = 1 To LENGTH
            C = (Rnd() * 2999) Mod 47
            If C < 10 Then
                C = C + 48
            ElseIf C = 46 Then
                C = 32
            Else
                C = C + 55
            End If
            If C > 90 Then
                If I < 1 Then Exit For
            Else
                S = S & Strings.Chr(C)
            End If
        Next J
        J = 1
        While Strings.MID(S, J, 1) = " "
            J = J + 1
        Wend
        A(I) = Strings.MID(S, J)
        P(I) = I
        If I Mod 1000 = 0 Then Say "GetRndStrs " & CStr(I)
    Next I
End Sub

Sub GetRndDbls(CNT As Long, A() As Double, P() As Long)
    Dim I As Long
    Dim D As Double
    
    Randomize
    ReDim A(0 To CNT + 1)
    For I = 1 To CNT
        D = CDbl(Exp(Rnd() * WorksheetFunction.LN(MaxDbl)))
        If Rnd < 0.5 Then A(I) = -D Else A(I) = D
        P(I) = I
    Next I
End Sub

Sub GetRndLngs(CNT As Long, A() As Long)
    Dim I As Long
    Dim L As Long
    
    Randomize
    ReDim A(0 To CNT + 1)
    For I = 1 To CNT
        L = CLng(Exp(Rnd() * WorksheetFunction.LN(MaxLng)))
        If Rnd < 0.5 Then A(I) = -L Else A(I) = L
    Next I
End Sub