This works for me...

Sub workbook_open()

Dim myRange As Range
Dim firstDate As Date
Dim datechk As Date

datechk = DateValue(Now)

If (Sheet2.Cells(1, 2)) < DateValue(Now) Then 'to avoid running macro more than once a day

todaysdate = DateValue(Now) 'GET TODAYS DATE
futuredate = DateValue(Now) + 20
Set myRange = Worksheets("sheet1").Range("C5:C40")'number of the members in the bthday list
For Each c In myRange 'SET RANGE HERE I.E. COLUMN TO COMPAIR TO

If c.Value >= todaysdate And c.Value <= futuredate Then
Dim name As String
Dim msg As String
name = Right(c.Address, 2) 'it will work only upto 100 rows in C column
Dim verb As String
verb = "'s birhtday is on "
msg = (Worksheets("sheet1").Cells(name, "B") & verb & c.Value)
Sheet2.Cells(1, 2) = datechk
bthdayreminder (msg)
End If
Next c
End If

End Sub



Sub bthdayreminder(msg)
'Working in 2000-2010

Dim OutApp As Object
Dim OutMail As Object
Dim Fname As String
Dim emailRng As Range, cl As Range
Dim sTo As String

Set emailRng = Worksheets("sheet3").Range("A2:A4") 'for multiple recipients

For Each cl In emailRng
sTo = sTo & ";" & cl.Value
Next

sTo = Mid(sTo, 2)
'Turn on Outlook for Excel
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

Dim myRange As Range
Dim firstDate As Date

With OutMail
.to = sTo
.CC = ""
.BCC = ""
.Subject = "Birthday Reminder"
'replace x with <
s = s & "<p><font face=""Monotype Corsiva"" size=""4"" "
s = "Hi Team, <br> "
s = s & "<br><b>" & msg & "</b><br>"
s = s & "<br> Thanks & Regards, <br> " & "xxx"

.HTMLBody = s
.Send 'or use
'Display
End With

Set OutMail = Nothing
Set OutApp = Nothing


End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Save'automatically saving the Workbook
End Sub