How to put random number from list

[Sumit_Bhokare]

Hello Team,

I have file in which there are few names in column A & Numbers are available in column C.

What required is - can we have random single number from list C2:C18 at active cell after click button.

i.e. if currently active cell is B2 & if we hit button then random number will be available at B2.

if active cell is B3 & if we hit button then random number will be available at B3

this is required till last name.

Doing this for birthday event within Team for surprise gift :)

[#2]

@Sumit_Bhokare 

Why not fill B2:B18 in one go?

[#3]

@Hans Vogelaar actually want doing this live during discussion hence one by one is required.

if its complicated then One go will also work, but one by one is preferred one :)

[#4 · Accepted solution]

@Sumit_Bhokare 

Code for the command button:

Private Sub CommandButton1_Click()
    Static arr()
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim tmp As Long
    If ActiveWindow.RangeSelection.CountLarge > 1 Then Exit Sub
    If Intersect(Range("B2:B18"), ActiveCell) Is Nothing Then Exit Sub
    If Application.Count(Range("B2:B18")) = 0 Then
        arr = Range("C2:C18").Value
        For k = 1 To 5
            For i = 1 To 17
                j = Application.RandBetween(1, 17)
                If j <> i Then
                    tmp = arr(i, 1)
                    arr(i, 1) = arr(j, 1)
                    arr(j, 1) = tmp
                End If
            Next i
        Next k
    End If
    ActiveCell.Value = arr(ActiveCell.Row - 1, 1)
End Sub

[#5]

@Hans Vogelaar Thank you for code, its working very well & very much appreciated.

Just few doubt, can you help to understand code by steps, if possible to you

and also not able to understand for what purpose k 1 to 5 is used.

[#6]

@Sumit_Bhokare 

I have added comments to most lines:

Private Sub CommandButton1_Click()
    Static arr()
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim tmp As Long
    ' Get out if the user selected more than one cell
    If ActiveWindow.RangeSelection.CountLarge > 1 Then Exit Sub
    ' Get out if the active cell is not in the range B2:B18
    If Intersect(Range("B2:B18"), ActiveCell) Is Nothing Then Exit Sub
    ' Is this the first time we click the button?
    If Application.Count(Range("B2:B18")) = 0 Then
        ' If so, store the values of C2:C18 in an array
        arr = Range("C2:C18").Value
        ' Shuffle the items of the array 5 times (this may be overkill)
        For k = 1 To 5
            ' Loop through the elements of the array
            For i = 1 To 17
                ' Get a random index
                j = Application.RandBetween(1, 17)
                ' If it is different from the current index, then ...
                If j <> i Then
                    ' Swap items #i and #j
                    tmp = arr(i, 1)
                    arr(i, 1) = arr(j, 1)
                    arr(j, 1) = tmp
                End If
            Next i
        Next k
    End If
    ' Set the value of the active cell to the corresponding value
    ' from the shuffled array
    ActiveCell.Value = arr(ActiveCell.Row - 1, 1)
End Sub

[#7]

@Hans Vogelaar Thank you for comments :)