In the exciting world of solutions looking for a problem to solve may I offer you this little gem.
As mentioned elsewhere I recently found a place that delivers meals free for $5 each if you order 10 at a time and having sampled them I am determined to make more use of the service. They offer about 15 meals and half a dozen deserts from this menu:
I wanted to select 10 meals at random to fill my freezer so here is a quick and dirty solution. Naturally it can be modified to select any number of items from any list at random.
This is the basic spreadsheet listing the available meals.
…and here is the VBA code that makes it work when you press the command button. The lines which start with a single quote are merely comments to explain what is happening and take no part in the action.:
Option Explicit
Sub SelectMeals()
Dim Lnth As Long
Dim Numb As Long
Dim Nxt As Long
Dim Slct As Long
Dim Meal As String
'Counter for meals selected
Nxt = 1
'Number of meals to Select (could be a cell value)
Slct = 10
'Length of meals listed
Lnth = Sheets(“Sheet1”).Cells(Rows.Count, “A”).End(xlUp).Row
Do
'Generate random number
Numb = Int(1 + Rnd * (Lnth - 1 + 1))
'Collect name of meal
Meal = Sheets(“Sheet1”).Range(“A” & Numb).Value
'Check to see if meal already selected
If IsError(Application.Match(Meal, Sheets(“Sheet2”).Range(“A:A”), 0)) Then
'if not previously selected add meal to list and increment number of meals selected Sheets(“Sheet2”).Range(“A” & Nxt).Value = Meal
Nxt = Nxt + 1
End If
Loop Until Nxt = Slct + 1
'Autofit column
Sheets(“Sheet2”).Range(“A1”).EntireColumn.AutoFit
'Print out list on your printer
Sheets(“Sheet2”).Range(“A1:A” & Lnth).PrintOut
'Clear the list ready for next time
Sheets(“Sheet2”).Range(“A1:A” & Lnth).Clear
End Sub
Well there you are… Get on with it!
