show list of people with birthdays within a week of today

[muizac]

Hello,

Hope you had a lovely Easter.

I have a worksheet of customers; Column N has DOB, and Column Y has their birthday date this year. Is there a macro that can show a list of all upcoming birthdays (<8 days from today's date) in another worksheet?

Thanks
Andrew

 

[Michael M]

Hey Andrew
In column Z try this and copy down as far as needed

=IF(TODAY()-Y1<8," Birthday coming Up","")

or for reference to another sheet

=IF(TODAY()-Sheet1!Y2<8," Birthday coming Up","")

 

[rudfaden]

You can use this macro. You will have to insert a new Sheet called birthday and insert the correct range.

Sub Brithday()
Dim rngBirthday As Range
Dim rngCell As Range
Dim Count As Long

Set rngBirthday = Sheet1.Range("B14:B96")

For Each rngCell In rngBirthday
If rngCell > DateAdd("d", 0, Date) And rngCell < DateAdd("d", 8, Date) Then
    Count = Count + 1
    Worksheets("Birthdays").Cells(Count, 1).Value = rngCell.Offset(0, -1).Value
    Worksheets("Birthdays").Cells(Count, 2).Value = rngCell.Value
End If
Next

 

[tusharm]

Consider using conditional formatting to highlight the upcoming birthdays.

Hello,

Hope you had a lovely Easter.

I have a worksheet of customers; Column N has DOB, and Column Y has their birthday date this year. Is there a macro that can show a list of all upcoming birthdays (<8 days from today's date) in another worksheet?

Thanks
Andrew

 

[muizac]

Thanks heaps - the Macro worked great.

Is there a way to make the list start in a current worksheet called input, at cell b40 - rather than the birthday worksheet from A1? And clear the previous list each time it's run? (clear input worksheet, cells B40:C45)

Thanks again for your help
Andrew

 

[rudfaden]

This should do it

Sub Brithday()
Dim rngBirthday As Range
Dim rngCell As Range
Dim Count As Long

Set rngBirthday = Worksheets("Input").Range("B1:B30")
Worksheets("Input").Range("A40:B48").Clear

For Each rngCell In rngBirthday
If rngCell > DateAdd("d", 0, Date) And rngCell < DateAdd("d", 8, Date) Then
    Count = Count + 1
    Worksheets("Input").Cells(39 + Count, 1).Value = rngCell.Offset(0, -1).Value
    Worksheets("Input").Cells(39 + Count, 2).Value = rngCell.Value
End If
Next
End Sub