“Nice to be here? At my age, it’s nice to be anywhere.” [George Burns]

You like to know when it’s time for donuts in your department? Then create a birthday list:

## Appendix sbBirthdayList Code

``````Function sbBirthdayList(r As Range) As Variant
'Create monthly birthday list.
'Reverse("moc.LiborPlus.www") V0.10 PB 15-Sep-2010
'Source (EN): http://www.sulprobil.com/sbbirthdaylist_en/
'Source (DE): http://www.bplumhoff.de/sbbirthdaylist_de/
'(C) (P) by Bernd Plumhoff 15-Sep-2010 PB V0.10
Dim vR(1 To 13, 1 To 3) As Variant
Dim i As Long, j As Long
Dim sNames(101 To 1231) As String

'Fill temporary array
For i = 1 To r.Rows.Count
If IsDate(r.Cells(i, 2)) Then
j = Month(r.Cells(i, 2))
vR(j + 1, 2) = vR(j + 1, 2) + 1 'Increasing DOB counter for month
j = j * 100 + Day(r.Cells(i, 2))
If sNames(j) <> "" Then sNames(j) = sNames(j) & ", "
sNames(j) = sNames(j) & r.Cells(i, 1)
End If
Next i

'Fill output area
vR(1, 1) = "Month"
vR(1, 2) = "#"
vR(1, 3) = "(Day) Names"
For i = 1 To 12
vR(i + 1, 1) = Format(DateSerial(1900, i, 1), "MMMM")
vR(i + 1, 3) = ""
For j = 1 To 31
If sNames(i * 100 + j) <> "" Then
If vR(i + 1, 3) <> "" Then vR(i + 1, 3) = vR(i + 1, 3) & ", "
vR(i + 1, 3) = vR(i + 1, 3) & "(" & j & ") " & sNames(i * 100 + j)
End If
Next j
Next i

sbBirthdayList = vR

End Function
``````