How to select a random cell from a range?

Question

I am trying to make a random cell chooser.

I have a list of names in column A - in cells 1 to 10.

I have a button on the sheet. It should randomly select one name in the list and make it another color.

Solution 1

You could use RandBetween worksheet function. It will generate a number between 1 and 10 and use that to select the cell within the range A1:A10. The example below is using an ActiveX command button in the sheet.

Option Explicit
Private Sub CommandButton1_Click()
    With ThisWorkbook.Worksheets("Sheet1").Range("A1:A10") '<==change to your sheet with data and button
        .ClearFormats
        .Cells(Application.WorksheetFunction.RandBetween(1, 10)).Interior.Color = vbRed
    End With
End Sub

If you want to take advantage of Randomize, for seed setting, you could use the following re-write. Source of function is wellsr.com (minor adaptation from me).

Option Explicit
Private Sub CommandButton1_Click()
    With ThisWorkbook.Worksheets("Sheet1").Range("A1:A10")
        .ClearFormats
        .Cells(RndBetween(1, 10)).Interior.Color = vbRed
    End With
End Sub

Public Function RndBetween(ByVal Low, ByVal High) As Integer
   Randomize
   RndBetween = Int((High - Low + 1) * Rnd + Low)
End Function

Solution 2

here you go

Sub random()

Dim ColumnA As Long
Dim StartRow As Long
Dim HeaderRow As Long
Dim LastRow As Long

ColumnA = 1
HeaderRow = 1  'this is redundant but to show you if you have header then your start row is 2
StartRow = 2
LastRow = Cells(Rows.Count, 1).End(xlUp).Row

Range(Cells(StartRow , ColumnA), Cells(LastRow, ColumnA)).Interior.Color = xlNone 'remove this line if you dont need resetting


Dim randomNum As Long
randomNum = WorksheetFunction.RandBetween(StartRow, LastRow)
Cells(randomNum, ColumnA).Interior.Color = RGB(255, 0, 0)
Cells(randomNum, ColumnA).Select



End Sub

Comments

[Imran Malek]

Go through the basics of vba macros

[Gander]

Please edit your answer to: improve text arragement, improve code formatting, See How to Answer