How to I select a random empty cell from a range of cells, until all cells in range have been selected?

Question

First time VBA coder here, so I'm not quite sure where to start.

I'm creating a "quiz" wherein a macro selects a random empty cell within a set range (C9:014). The user then types something into the cell and presses Enter. Then, the macro selects another empty cell within the set range (C9:O14). The user again types something into the selected cell and presses Enter. This process repeats until all 78 cells in the range have been filled by the user.

I suspect that some sort of Do Until loop is involved.

Does anyone have any ideas on how to do this?

Thanks so much guys.

Answer 1

Welcome on board!

Using this code:

1. The game starts once you activate the sheet.
2. The player can't change the selection made by the code.

First, add this code to worksheet's Module (in worksheet code pane (right-click on the tab and select "View code") put the following):

Private Used_Range As Range, Quiz_Range As Range, ThisCell As Range, PreventSelect As Boolean

Private Sub Worksheet_Activate()
    FreshStart
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim n As Long, nMax As Long
    OnError GoTo ex
    Application.EnableEvents = False
    If Quiz_Range Is Nothing Then FreshStart
    If Not Used_Range Is Nothing Then
        If Used_Range.Address = Quiz_Range.Address Then
            If MsgBox("Game Over!" & Chr(10) & "Do you want to start over?", vbYesNo) = vbYes Then
                FreshStart
            Else
                GoTo ex
            End If
        End If
    End If
    nMax = Quiz_Range.Cells.Count
    n = RandBetween(1, nMax)
    If Used_Range Is Nothing Then
        Set ThisCell = Quiz_Range.Cells(n)
        Set Used_Range = ThisCell
    Else
        Do Until Intersect(Quiz_Range.Cells(n), Used_Range) Is Nothing
            n = n + 1
            If n > nMax Then n = 1
        Loop
        Set ThisCell = Quiz_Range.Cells(n)
        Set Used_Range = Union(Used_Range, ThisCell)
    End If
    Quiz_Range.Cells(n).Select
ex:
    Application.EnableEvents = True
    PreventSelect = False
End Sub
Function RandBetween(MinInt As Long, MaxInt As Long) As Long
    RandBetween = Int((MaxInt - MinInt + 1) * Rnd + MinInt)
End Function
Sub FreshStart()
    Set Used_Range = Nothing
    Set Quiz_Range = Range("C9:O14")
    Quiz_Range.ClearContents
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.EnableEvents = False
    If PreventSelect Then
        ThisCell.Select
        MsgBox "You can't select another cell!"
    End If
    PreventSelect = True
    Application.EnableEvents = True
End Sub

Note: This random selector selects the next unused cell if the output of the Rnd function refers to a used cell.

---

Edit #1

Using the randomizing collection method by @HTH, the code can be much better:

Private coll As Collection, Quiz_Range As Range, ThisCell As Range, PreventSelect As Boolean
Private Sub Worksheet_Activate()
    FreshStart
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim n As Long, nMax As Long, m As Long
    OnError GoTo ex
    Application.EnableEvents = False
    If Quiz_Range Is Nothing Then FreshStart
    If coll.Count = 0 Then
        If MsgBox("Game Over!" & Chr(10) & "Do you want to start over?", vbYesNo) = vbYes Then
            FreshStart
        Else
            GoTo ex
        End If
    End If
    n = Int(1 + Rnd * (coll.Count))
    Quiz_Range.Cells(coll(n)).Select
    coll.Remove n
ex:
    Application.EnableEvents = True
    PreventSelect = False
End Sub
Sub FreshStart()
    Set Quiz_Range = Range("C9:F14")
    SetColl Quiz_Range
    Quiz_Range.ClearContents
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.EnableEvents = False
    If PreventSelect Then
        ThisCell.Select
        MsgBox "You can't select another cell!"
    End If
    PreventSelect = True
    Application.EnableEvents = True
End Sub
Sub SetColl(rng As Range)
    Set coll = New Collection
    Dim i As Long
    For i = 1 To rng.Count
         coll.Add i
    Next
End Sub

Answer 2

in worksheet code pane (right clik on the tab and select "View code") put the following

Option Explicit

Dim quizRng As Range
Dim coll As Collection
Dim i As Long

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not quizRng Is Nothing Then If WorksheetFunction.CountBlank(quizRng) > 0 Then SelectCell Else MsgBox "game over"        
End Sub

Sub Start()
    Set quizRng = Range("C9:O14")
    With quizRng
        SetColl .Cells
        .ClearContents
        i = 0
    End With
End Sub

Sub SelectCell()
    Dim n As Long        
    With quizRng
        If coll.Count = 0 Then Exit Sub
        i = i + 1
        n = Int(1 + Rnd * (coll.Count))
        .Cells(coll(n)).Select

        coll.Remove n
    End With        
End Sub

Sub SetColl(rng As Range)
    Set coll = New Collection
    Dim i As Long
    For i = 1 To rng.Count
         coll.Add i
    Next
End Sub

Then add a Button to your sheet and assign it the Start macro

The user will have to click the button to start the game and then just write into cells that are progressiveley selected by the code until the "game over" message

Edit

alternatively to a button, as in @AbdallahEl-Yaddak answer, you could have it al started by the sheet activating just adding the following code

Private Sub Worksheet_Activate()
    MsgBox "Start of the game!"
    Start
End Sub

Edit 2

changed

.Cells(m \ .Columns.Count + IIf(m Mod .Columns.Count = 0, 0, 1), IIf(m Mod .Columns.Count = 0, .Columns.Count, m Mod .Columns.Count))

to

.Cells(coll(n)).Select

thanks to @AbdallahEl-Yaddak

Answer 3

Give the name of the range (on which you will play the game) in cell A1.

Sub quiz()
    Dim ws As Worksheet, target As Range
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set target = ws.Range(ws.Range("A1").Value)
    Total = target.Rows.Count * target.Columns.Count
    random = Rnd(Total)
    For Each cell In target
    If cell.Value = "" Then
    cell.Select
        If cell.Row * cell.Column = random Then
        Exit For
        End If
    End If
    Next cell
    End Sub

Answer 4

This assumes that all the cells in the block are initially empty:

Sub JustaGame()
    Dim rng As Range, arr(1 To 78) As Variant
    Set rng = Range("C9:O14")

    i = 1
    For Each r In rng
        arr(i) = r.Address(0, 0)
        i = i + 1
    Next r

    Call Shuffle2(arr)
    For i = 1 To 78

        addy = arr(i)
        v = Application.InputBox(Prompt:="Please enter a value for cell " & addy, Type:=2)
        Range(addy) = v
    Next i
End Sub

Public Sub Shuffle2(InOut() As Variant)
    Dim o As Object, oc As Long, i As Long, io
    Dim j As Long, k As Long

    Hi = UBound(InOut)
    Low = LBound(InOut)
    ReDim helper(Low To Hi) As Variant
    Randomize


    Set o = CreateObject("System.Collections.ArrayList")
    For Each io In InOut
        o.Add io
    Next io

    j = Low
    oc = o.Count - 1
    For i = 1 To oc
        k = Int((o.Count - 1 - 0 + 1) * Rnd() + 0)
        helper(j) = o.Item(k)
        j = j + 1
        o.RemoveAt k
    Next i

    helper(j) = o.Item(0)

    For j = Low To Hi
        InOut(j) = helper(j)
    Next j

    Set o = Nothing
End Sub

Note:

1. arr() is a complete list of the addresses in the block
2. Shuffle2() creates a random permutation of that list
3. the code fills the cells in the random order specified above

EDIT#1:

This version of Shuffle() does not need ArrayLists:

Public Sub Shuffle(InOut() As Variant)
    Dim i As Long, j As Long
    Dim tempF As Double, Temp As Variant

    Hi = UBound(InOut)
    Low = LBound(InOut)
    ReDim helper(Low To Hi) As Double
    Randomize

    For i = Low To Hi
        helper(i) = Rnd
    Next i


    j = (Hi - Low + 1) \ 2
    Do While j > 0
        For i = Low To Hi - j
          If helper(i) > helper(i + j) Then
            tempF = helper(i)
            helper(i) = helper(i + j)
            helper(i + j) = tempF
            Temp = InOut(i)
            InOut(i) = InOut(i + j)
            InOut(i + j) = Temp
          End If
        Next i
        For i = Hi - j To Low Step -1
          If helper(i) > helper(i + j) Then
            tempF = helper(i)
            helper(i) = helper(i + j)
            helper(i + j) = tempF
            Temp = InOut(i)
            InOut(i) = InOut(i + j)
            InOut(i + j) = Temp
          End If
        Next i
        j = j \ 2
    Loop
End Sub

In the main program, change:

Call Shuffle2(arr)

to:

Call Shuffle(arr)