-2

In sheet1 in column B i have names In sheet 1 in column D i have birthday dates

B:
Ben
Mikael

D:
3 MARCH 1987
3 JUNE 1976

I want to find a VBA script to make a popup msgbox and print out "There is 10 days or less untill NAME(from column B) have a birthday".

How can this be done?

Behedwin
  • 27
  • 2
  • 8
  • So if the person was born *January 5 1948* you want the next message issued on *December 26 2016* ?? – Gary's Student May 24 '16 at 20:15
  • exactly, 10 days before the person will have a birthday. like a warning 10 days ahead for the user of the excel document. it needs to be written in vba – Behedwin May 24 '16 at 20:18
  • Yes, it can be done. You can use Outlook or a nice calendar program to do that for you. Or you can write a macro that checks the dates, and warns you if one is less than 10 days away. The drawback is that you will have to open this Excel file every day for the macro to run. Or you can use `Application.OnTime`, and never turn off your computer and never close Excel. – vacip May 24 '16 at 20:20
  • 3
    "it needs to be written in vba" - why??? Wait, you don't expect *us* to do *your* homework/job for you for free, do you? – vacip May 24 '16 at 20:21
  • How many names do you have? I mean, what happens if you need a warning for 1000 people? How do you want that handled? 1000 msgboxes? 1 long one with 1000 names? – findwindow May 24 '16 at 20:24

2 Answers2

1

In E1 enter:

=DATE(YEAR(D1)+DATEDIF(D1,TODAY(),"y")+1,MONTH(D1),DAY(D1))

and copy down. Then in F1 enter:

=E1-TODAY()

and copy down.

Column E are the upcoming birthdays and column F are the days until the next birthday.

Finally in the worksheet code area, enter the following event macro:

Private Sub Worksheet_Activate()
    Dim cel As Range, F As Range

    Set F = Intersect(ActiveSheet.UsedRange, Range("F:F"))
    For Each cel In F
        If cel.Value < 11 Then
            MsgBox cel.Offset(0, -4).Value & " will have a birthday in " & cel.Value & " days"
        End If
    Next cel
End Sub

You will get the messages whenever the worksheet is activated:

enter image description here

Gary's Student
  • 95,722
  • 10
  • 59
  • 99
  • after quick reading your post. am i right that you first calculated how many days until next birth day. Then in the VBA script telling a message to popup if the value is 10 or less? – Behedwin May 24 '16 at 20:52
  • You are correct!................I use something similar, but I hi-light the names using Conditional Formatting rather than macros. – Gary's Student May 24 '16 at 20:57
  • cant figure out if this way is better than my way (below). is there any disadvantages than doing what i did in the code? – Behedwin May 24 '16 at 21:01
  • @Behedwin If you are happy with your own code, then use it................I like my approach because I can see all the people and how close the birthdays are. – Gary's Student May 24 '16 at 21:06
0

I think i figured out a way to do what i wanted.

Thanks for your kind commends btw.

Below is the code that i got to work. But for it to work i had to first take the birthdate and devide it up into three cells, day, month and year. then i again combine day and month but not the year, instead i used the year(now()) and got the birthdate this year.

then i could use below code to add 1-10 days with dateadd.

this feels a bit clumsy... but so far i think it will work.

Sub checkearlybirthday()
Dim ans As String
Dim cell As Range

For Each cell In Sheets("Personal").Range("rf10:rf500")
    If cell = DateAdd("d", 1, Date) Or cell = DateAdd("d", 2, Date) Or cell = DateAdd("d", 3, Date) Or cell = DateAdd("d", 4, Date) Or cell = DateAdd("d", 5, Date) Or cell = DateAdd("d", 6, Date) Or cell = DateAdd("d", 7, Date) Or cell = DateAdd("d", 8, Date) Or cell = DateAdd("d", 9, Date) Or cell = DateAdd("d", 10, Date) Then
        ans = ans & vbNewLine & Sheets("Personal").Cells(cell.Row, 2).Value
    End If
Next

If Len(ans) < 1 Then

Else
    MsgBox "Hallå! " & vbNewLine & "Det är 10 dagar eller mindre till dessa fyller år. " & ans & "  " & vbNewLine & ""
End If

End Sub

Behedwin
  • 27
  • 2
  • 8