Option Explicit

Function RandomNumbers(ByVal NumItems As Long, _
        Optional ByVal Base As Long = 1) As Variant
    Dim a() As Long
    Dim i As Long, j As Long, k As Long
    On Error GoTo ErrorHandler
    ReDim a(0 To NumItems - 1)
    For i = 0 To NumItems - 1
        a(i) = Base + i
    Next
    Randomize
    For i = NumItems - 1 To 1 Step -1
        j = Int(Rnd() * (i + 1))
        If j <> i Then k = a(i): a(i) = a(j): a(j) = k
    Next
    RandomNumbers = a
    Exit Function

ErrorHandler:
    Exit Function
End Function


Sub Shuffle()
    Dim addr As String
    Dim i As Long, j As Long, k As Long, n As Long
    Dim a As Variant, buf As Variant
    Dim r As Range, r2 As Range

    If TypeName(Selection) = "Range" Then
        addr = Selection.Address
    End If
    On Error Resume Next
    Set r = Application.InputBox( _
        Prompt:="Select the range to shuffle.", _
        Default:=addr, Title:="Shuffle", Type:=8)
    On Error GoTo 0
    If r Is Nothing Then Exit Sub
    n = r.Count
    If n > &H100000 Then
        MsgBox "Too many cells", vbExclamation
        Exit Sub
    End If
    If MsgBox("You cannot undo changes. Continue?", _
        vbOKCancel Or vbExclamation, "Shuffle") <> vbOK Then Exit Sub

    a = RandomNumbers(n)
    If IsArray(a) Then
        k = 0
        For Each r2 In r.Areas
            ReDim buf(1 To r2.Rows.Count, 1 To r2.Columns.Count)
            For i = 1 To UBound(buf)
                For j = 1 To UBound(buf, 2)
                    buf(i, j) = r2(a(k))
                    k = k + 1
                Next
            Next
            r2.Value2 = buf
        Next
    Else
        MsgBox "Fail to generate random numbers.", vbExclamation
    End If
End Sub

Sub FillWithRandomeNumbers()
    Dim addr As String
    Dim i As Long, j As Long, k As Long, n As Long
    Dim a As Variant, v As Variant, buf As Variant
    Dim r As Range, r2 As Range

    If TypeName(Selection) = "Range" Then
        addr = Selection.Address
    End If
    On Error Resume Next
    Set r = Application.InputBox( _
        Prompt:="Select the range to fill with random numbers.", _
        Default:=addr, Type:=8)
    On Error GoTo 0
    If r Is Nothing Then Exit Sub
    
    v = Application.InputBox( _
        Prompt:="Input the base number.", _
        Default:=1, Type:=1)
    If VarType(v) = vbBoolean Then Exit Sub
    
    On Error Resume Next
    v = CInt(v)
    If Err <> 0 Then
        On Error GoTo 0
        MsgBox "The base number is too large.", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
    
    If MsgBox("You cannot undo changes. Continue?", _
        vbOKCancel Or vbExclamation) <> vbOK Then Exit Sub

    a = RandomNumbers(r.Count, v)
    If IsArray(a) Then
        k = 0
        For Each r2 In r.Areas
            ReDim buf(1 To r2.Rows.Count, 1 To r2.Columns.Count)
            For i = 1 To UBound(buf)
                For j = 1 To UBound(buf, 2)
                    buf(i, j) = a(k)
                    k = k + 1
                Next
            Next
            r2.Value2 = buf
        Next
    Else
        MsgBox "Fail to generate randome numbers.", vbExclamation
    End If
End Sub