Fill Derby pool squares

gebobs · #1 05-02-2018, 01:14 PM

OK people...I am garbage at VBA. I hope someone better versed could bang this out pretty quickly.

I am setting up a workbook for a Derby pool. People will probably be arriving late and getting all their names into the pool by post time will be a challenge so I'd like to automate it as much as possible.

The way I see it now is the routine begins by asking what the person's initial are and how many squares they want. That much I think I can do. :-)

At this point, I would like the routine to find a random cell in the table, check if it's empty, if not then search again, if it is then enter Player. Repeat for number of Squares.

Currently, the table (DerbyField) is 20 rows (each Derby entrant) by 4 pool columns (Win, Place, Show, and Last). Columns won't change but there may be last minute scratches to the field so some rows may be deleted.

The random search is important. Obviously, I don't want people grabbing all the squares for the favorite or for the Win column.

Anyone care to take a stab at this?

dwirony · #2 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.

gebobs · #3 05-03-2018, 05:47 AM

Excellent. Thank you very much!

I'm checking. There's one bug but I'm trying to fix.

gebobs · #4 05-03-2018, 06:02 AM

Everything was fine except the second parameter of the randbetweens. I changed to

x = Application.WorksheetFunction.RandBetween(2, 21)
y = Application.WorksheetFunction.RandBetween(4, 7)

Thank you so much dwirony!

gebobs · #5 05-03-2018, 06:36 AM

If anyone wants to use this or even make it better, here it is.

Rather than input the names I have it taking it from the list on the right. Have the name be the active cell before pressing Fill.

It also checks for overflow. Otherwise, if there are only four squares left and the next Fill is putting in more, the routine was going haywire.

dwirony · #6 05-03-2018, 07:01 AM

Ah yes - I should've put a simple

Code:

If numofsquares > squaresremaining Then Exit Sub

And you're welcome.

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Microsoft word Page has 4 quarter squares on each paper	AZn	Word	3	05-18-2017 07:50 AM
Email displaying squares instead of text	glenforum	Outlook	3	01-15-2013 09:14 AM
Corrupt file. My entire manuscript just turned into small squares.	wytxny	Word	2	05-03-2012 07:13 AM
Use only rsource pool	gdallas	Project	0	11-25-2010 01:10 PM
The characters of my received emails are little squares! HELP!	chocolatecookies	Outlook	0	12-17-2008 04:17 PM