The code for this sample report is written in VBscript. Like all the reports, you are welcome to modify the code to suit your needs.
The years shown are the ages at the next coming up Birthdays or Anniversaries. As these figures are computed with the date of the report generation, please make sure your system date is correctly setup.
GB, US and MD (modern) marriage anniversaries 'gifts' lists are supported. The default one is GB. You may change the code if you want to, in line no. 26.

Report generated on <%[Report.WriteFormattedBr "{0}.", (Now)]%> Birthdays & Anniversaries

Birthdays & Anniversaries from @[Report.WriteText(ReportGenerator.Document.Name)]@

Listing of all birthdays and anniversaries of living individuals and families.

<%[ Dim aWedAnnivGB, aWedAnnivUS, aWedAnnivMD, ColInd, ColFam, i, j, o, oNewRep, oRecord Dim nAge, nArrayAge, nDate, nLoopFlag, nRecords, strArrayCode, strArrayName, strBdayToday Dim strColor, strMissYear, strMonthDay, strMonthDayPrev, strString, strWedAnniv ' colors definition Const clrBirthAnnivNow = "#da70d6" ' orchid ' color for flagging Bdays/Annivs on Rep Gene day Const clrWedAnniv = "#9acd32" ' yellowgreen ' color for flagging the coming Marriage Anniv 'gift' Const clrMonthDay = "#0000cd" ' mediumblue ' color used for days and months Const clrNoData = "#ff0000" ' red ' color for flagging missing years from .gno file ' wedding annivs arrays() strArrayCode = "GB" ' here you can change the Wedding Anniversary array() code to "US" (American) or "MD" (Moderne). strArrayName = "aWedAnniv" + UCase(Trim(strArrayCode)) aWedAnnivGB = Array("01Paper","02Cotton","03Leather","04Fruit/Flowers","05Wood","06Sugar","07Wool/Copper",_ "08Bronze/Pottery","09Pottery/Willow","10Tin","11Steel","12Silk/Linen","13Lace","14Ivory","15Crystal","16Tungsten",_ "17Turquoise","18Bismuth","19","20China","25Silver","30Pearl","35Coral","40Ruby","45Sapphire","50Gold","55Emerald",_ "60Diamond","65Star Sapphire","70Platinum","75Diamond","80Oak","90Granite") aWedAnnivUS = Array("01Paper","02Cotton","03Leather","04Linen/Silk","05Wood","06Iron","07Wool/Copper","08Bronze",_ "09Pottery","10Tin/Aluminum","11Steel","12Silk","13Lace","14Ivory","15Crystal","16","17","18Bismuth","19","20China",_ "25Silver","30Pearl","35Coral/Jade","40Ruby","45Sapphire","50Gold","55Emerald","60Diamond","65Star Sapphire","70Platinum",_ "75Diamond","80Oak","90Granite") aWedAnnivMD = Array("01Clocks","02China","03Crystal/Glass","04Appliances","05Silverware","06Wood","07Desk Sets",_ "08Linens/Lace","09Leather","10Diamond","11Fashion jewelry","12Pearls/Colored gems","13Textiles/Furs","14Gold Jewelry",_ "15Watches","16Silver holloware","17Furniture","18Porcelain","19Bronze","20Platinum","25Sterling silver","30Diamond",_ "35Jade","40Ruby","45Sapphire","50Gold","55Emerald","60Diamond","65Star Sapphire","70","75Diamond","80Diamond/Pearl",_ "90Diamond/Emerald") Set oNewRep = Util.NewObjectRepertory() ' create a new blank repertory Set ColInd = ReportGenerator.Document.Collection("Individuals") ' create the Individuals collection for processing For Each i in ColInd If (Not i.IsDead and i.Birth.Date.NDay > 0 and i.Birth.Date.NMonth > 0) Then oNewRep.Add i.Birth.Date.ToString("MMddyyyy"), i.Name ' add alive Individuals (with Bday & month) into repertory End If Next Set ColFam = ReportGenerator.Document.Collection("Families") ' create the Families collection for processing For Each i in ColFam If (i.AreTogether and i.Marriage.Date.NDay > 0 and i.Marriage.Date.NMonth > 0) Then oNewRep.Add i.Marriage.Date.ToString("MMddyyyy"), i.Name ' add AreTogether Families (with Wedding day & month) into repertory End If Next oNewRep.SortByKey() ' sort the repertory by date (month + day + year) nRecords = oNewRep.Count - 1 For i = 0 To nRecords ' loop through every record Set oRecord = oNewRep.Entry(i) strMonthDay = Left(oRecord.Key,4) If (Len(oRecord.Key) = 8) Then nDate = CDate(Right(oRecord.Key,4) + "/" + Left(oRecord.Key,2) + "/" + Mid(oRecord.Key,3,2)) nAge = Int((Now - nDate) / 365.25) + 1 Else nAge = 0 End If If (strMonthDay <> strMonthDayPrev) Then Report.WriteFormatted "" + "{0} {1}" + "
", MonthName(Left(strMonthDay,2)), FormatNumber(Right(strMonthDay,2),0,0) strMonthDayPrev = strMonthDay End If strBdayToday = "" For Each o In oRecord nLoopFlag = 0 If ((Month(nDate) = Month(Now)) and (Day(nDate) = Day(Now))) Then strBdayToday = HtmlColorString("BIRTHDAY TODAY!!", clrBirthAnnivNow) nAge = nAge - 1 End If If (Instr(o," and ") > 0 and nAge > 0) Then ' for family with a marriage age For j = 0 To 32 ' read the anniv gift array() nArrayAge = CInt(Left(Eval(strArrayName)(j),2)) If (nArrayAge = nAge) Then strWedAnniv = Right(Eval(strArrayName)(j), Len(Eval(strArrayName)(j))-2) If strWedAnniv <> "" Then strWedAnniv = HtmlColorString(strWedAnniv, clrWedAnniv) strWedAnniv = " - " + strWedAnniv + " wedding anniversary" End If Report.WriteFormatted " - {0} ({1} year{2}{3}) {4}
", o, nAge, Util.IfElse(nAge=1,"","s"), strWedAnniv, strBdayToday nLoopFlag = 1 Exit For End If Next If (nLoopFlag = 0) Then Report.WriteFormatted " - {0} ({1} year{2}) {3}
", o, nAge, Util.IfElse(nAge=1,"","s"), strBdayToday End If Else strMissYear = HtmlColorString("???", clrNoData) Report.WriteFormatted " - {0} ({1} year{2}) {3}
", o, Util.IfElse(nAge=0, strMissYear, nAge), Util.IfElse(nAge=1,"","s"), strBdayToday End If Next Next Function HtmlColorString(strString, strColor) HtmlColorString = "" + strString + "" End Function ]%>