Microsoft Office Forums - View Single Post

dwirony · 05-02-2018, 02:11 PM

Here you go - this should work for you:

Code:

Sub Test()

Dim i As Long, x As Long, y As Long, initials As String, numberofsquares As String

initials = Application.InputBox("What are the initials?")
numberofsquares = Application.InputBox("How many squares?")

Do Until i = numberofsquares
    x = Application.WorksheetFunction.RandBetween(2, 20)
    y = Application.WorksheetFunction.RandBetween(4, 8)
    
    If Cells(x, y).Value = "" Then
        Cells(x, y).Value = initials
        i = i + 1
    End If
Loop

End Sub

NOTE: This will crash if the number of squares you enter is greater than the number left - I can add something to catch that for you if you need it, I've just given you the basic shell here.