If you want to build your own advent calendar with a selection of gifts, then you can use the template we are building to randomise their order without knowing what you’re getting from day to day. Of course this template could be used for any sort of secret randomisation – and the VBA we will use to build it could be used for much more!

The template and first steps

Our template will have three parts. First, an Input tab where we can specify which items we have to be randomised:

(based on my household’s own selection of Hotel Chocolat goodies, if you must know!)

This is an Excel Table named ItemList, which allows for us to easily refer to it in the VBA later on.

The Output tab is pretty plain at the moment:

There is also a third, hidden tab – called “Calculations (hidden)”.This is where our VBA will create the randomised lists of items and store them, for the “Reveal items” button to pull out later on.

We now create a simple sub which will ask the user how many advent calendars they want, and whether they want to prevent the same item being chosen twice in a row, before calling the main sub that will generate the randomised lists:

Sub MakeLists()

Dim Lists As Integer
Dim NoDupes As Boolean

Lists = InputBox("How many lists to make?")
NoDupes = Application.InputBox("Prevent duplication?  Type TRUE or FALSE.", , , , , , , 4)

Call Randomiser(Lists, NoDupes)

End Sub

We’ve spoken about InputBox before and used it for gathering user input.  But InputBox only returns string data – for our NoDupes variable we want a Boolean (True/False value), and so we can use Application.InputBox instead.  This can take several kinds of input, including Booleans, controlled by the final input you see above (4 is the value for Booleans).

Finally, we use Call to pass these variables to our main sub.

Building the lists

We are going to build up the required number of lists, randomise them, and if necessary check that they have no duplicated items on consecutive days. Here’s the broad structure of our sub:

Sub Randomiser(Lists As Integer, NoDupe As Boolean)

Application.ScreenUpdating = False

Sheets("Calculation (hidden)").Range("A1:XFD1048576").Clear

[loop to create, randomise, and check the lists]

Sheets("Output").Activate
Range("NoOfLists") = Lists

Application.ScreenUpdating = True

End Sub

We switch off the screen updating for the duration, so that the hidden tab is not revealed and the order remains a surprise to the user.  We start by clearing the Calculation sheet (in case the template is reused later), then create our lists.  Finally, we move the user to the Output tab and update the named range “NoOfLists”, which you can see in the screenshot above, to the number of lists that have been generated.  This will be used later when returning values.

The loop is where most of our coding work goes.  The broad approach will be as follows:

1. Create a column of random values of the same size as the ItemList table
2. List out the items from the ItemList table
3. Sort the items by the list of random values in order to randomise their order
4. If required, check for duplicated items on consecutive days
5. Repeat steps 1-4 until the required number of lists have been created

Let’s take each step one at a time.  Step 1: Create a range of random numbers

Sheets("Calculation (hidden)").Activate

For j = 1 To Range("ItemList").Rows.Count

                   Cells(j, 2 * i - 1) = Rnd

Next j

Note that we use i (which will be the count of which list we are on from the main loop) and j (the counter of which item in the list we are on) to determine which cell we are writing into.  The Rnd object generates random numbers the same way that the RAND function does in regular Excel.

Step 2: List out the items as they appear in the ItemList table:

For j = 1 To Range("ItemList").Rows.Count

                Cells(j, 2 * i) = Range("ItemList").Cells(j, 1)

Next j

Step 3: Sort the items:

Range(Cells(1, 2 * i - 1), Cells(Range("ItemList").Rows.Count, 2 * i)).Sort _
key1:=Cells(1, 2 * i - 1), order1:=xlAscending

Note the use of an underscore character here as a line-break – this is useful any time you have a very long instruction to aid readability.  Here we are using the Range.Sort method, which can sort any range.  Once again we use i and j to identify the appropriate range.  The Range.Sort method uses a couple of variables: Keys, and Orders.  Keys are one or more columns which will be used for the sorting, and Orders are the variables xlAscending and xlDescending which identify which way around the sort will be done.

Step 4: If the user has asked for consecutive items to not have repeat items, check that the randomised items don’t do that:

If NoDupe Then

Repeats = False
For k = 2 To Range("ItemList").Rows.Count

If Cells(k, 2 * i) = Cells(k - 1, 2 * i) Then

Repeats = True

Else
End If

Next k

Else
End If
If Repeats Then
Else

i = i + 1

End If

NoDupe is the variable we passed in that identifies whether we want to do the check.  If so, we check each pair of items with the k-loop, and if necessary set the “Repeats” flag to true.  At the end, we increment the list number (i) only if this flag was not enabled.  This means that if we generate a list with duplicates, then we will try again, moving on only when we get a clear run.

Finally, we have one last sub that will extract the items up to a specific day for the advent calendar (we list the older items as well to help people catch up if they miss one):

Sub ListItems()

Range("A4:XFD1048576").Clear

Dim ListLength As Integer
ListLength = InputBox("How many days' items would you like to show?")

For i = 1 To ListLength

For j = 1 To Range("NoOfLists")

Worksheets("Output").Range("a3").Offset(i, j).Activate

ActiveCell.Value = Sheets("Calculation (hidden)").Cells(i, 2 * j).Value

Next j

Next i

Range("A:XFD").EntireColumn.AutoFit

End Sub

You can examine all three of the full subs – or just use the template yourself – by downloading it here.

You may also like

• Previous post - Power Pivot: Measures
• TOTW index 
• Next time – Revisiting ROW(S) and COLUMN(S) functions!