- My VBA coding skills are actually horrible and I'd be ashamed to profit from them.
- It would almost certainly complicate my taxes which I can barely do as it is.
- The only people who would buy it would be people who read my blog, and I love you all too much to let money come between us.
Okay so my stupid worksheet looks like this:
Oh look, it's being ironically festive! Maybe it should move to Capitol Hill and read the Stranger on its iPhone while wearing jeans that are way too small! If you don't live in Seattle you have no idea what I'm talking about!
Anyway, let me point out the nicer features:
I grabbed that Santa from a Secret Santa excel template that Microsoft hosts. Their template sucks though because it doesn't shuffle the names for you, so don't bother looking for it. I googled "free holiday clip art" to get those other two images.
Dynamic Named Ranges
Dynamic named ranges are awesome. I think I first read about them on the PHD Blog. Anyway, there are three in this worksheet, but they all look like this, which points to the gift givers column:
=OFFSET('Secret Santa Name Picker'!$C$3,0,0,COUNTA('Secret Santa Name Picker'!E:E)-1,1)
So it's just counting how many entries there are in all of column C, subtracting out 1 for the column title, and creating a range with that height starting at cell C3. I guess I should briefly explain the offset function. It returns a cell or range reference, and the arguments are as follows:
=OFFSET(starting cell, cells moved left (negative for right), cells moved down (negative for up), range height, range width)
So my formula starts at cell C3, doesn't offset because that is the column I want, and has a height equal to the entries in the column (less the title) and a width of one. Now the name, Givers, will always point to all of the names in column C, no matter how many I enter. Don't try to be clever and break it by leaving blank spaces in the middle of the list, and yes that will break it. The other ranges are Receivers (self explanatory) and Dummy (which refers to me for having to add a "helper" column because I don't know how to use data types in VBA).
A button! I really have no idea how this works. I cannibalized two pieces of code, mashed them together, and ran through the debugger about a million times tweaking things until it finally worked. The basic idea: I take the input range, Givers, and copy its entries to the Receivers range. At the same time I populate the Dummy range with random numbers. I then sort both Receivers and Dummy by the values in Dummy, effectively randomizing the order of the names. Finally, I run back through both Givers and Receivers making sure none of the entries match (if your family allows people to draw their own name in Secret Santa, you're doing it wrong). If the entries do match, it goes back through the array and switches it with the first value that won't cause either entry to match the Givers range.
Here it is:
Private Sub CommandButton1_Click()That's about all there is to it. You can download the workbook here. Remember to enable macros or it won't work. Happy holidays!
Dim xTemp As Double
Dim yTemp As String
Dim i As Long
Dim j As Long
Dim vArr As Range
Dim l As Integer
Dim moreDifferentArray As Range
Dim returnArray As Range
l = Range("arraysize")
Set vArr = Range("Givers")
Set returnArray = Range("Receivers")
Set moreDifferentArray = Range("Dummy")
'pass range values to array
For i = 1 To l
returnArray(i) = vArr(i)
moreDifferentArray(i) = Rnd()
'sort I think. Forgot where this came from, sorry...
For j = 2 To l
xTemp = moreDifferentArray(j)
yTemp = returnArray(j)
For i = j - 1 To 1 Step -1
If (moreDifferentArray(i) <= xTemp) Then GoTo 10
moreDifferentArray(i + 1) = moreDifferentArray(i)
returnArray(i + 1) = returnArray(i)
i = 0
10 moreDifferentArray(i + 1) = xTemp
returnArray(i + 1) = yTemp
'check for dupes
For i = 1 To l
If vArr(i) = returnArray(i) Then
For j = 1 To l
If vArr(j) <> returnArray(i) Then
yTemp = returnArray(i)
returnArray(i) = returnArray(j)
returnArray(j) = yTemp
j = l