sbBirthdayList

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

Please read my Disclaimer.

Function sbBirthdayList(r As Range) As Variant
'Create monthly birthday list.
'Reverse("moc.LiborPlus.www") V0.10 PB 15-Sep-2010
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