VBA FOR expiry Date

A

Alam

Dear All
Please any one can help me.
If My Data Like
NAME PASSPORT NO. ISSUED DATE PASSPORTEXPIRY
DATE
LOUIS HENNERY B125556 5/5/2004 5/5/2007
VICTOR H. S A125586 1/9/2005 1/9/2008

I want when I open this data file, MsgBox showing the list name of staff
their passport is near or already .
Thanks
 
D

Don Guillett

Sub expirydate()
For Each d In Range("d2:d" & Cells(Rows.Count, "d").End(xlUp).Row)
If d - Date >= 0 And d - Date < 10 Then MsgBox d.Offset(, -3) & "'s
expiring"
Next d
End Sub
 
R

RadarEye

Hi Alam

Open tha VBA by pressing [Alt]+{F11].
Add the code below to "ThisWorkbook"

Private Sub Workbook_Open()
Dim datTestAgainst As Date
Dim strPrompt As String
Dim intRow As Integer
Dim blnPrompt As Boolean

datTestAgainst = DateAdd("M", 2, Date)
intRow = 2
strPrompt = "Date" & vbTab & "Name"
Do
If Cells(intRow, 4) < datTestAgainst Then
strPrompt = strPrompt & vbNewLine & Cells(intRow, 4).Value
& vbTab & Cells(intRow, 1)
blnPrompt = True
End If
intRow = intRow + 1
Loop Until IsEmpty(Cells(intRow, 4))

If blnPrompt Then
MsgBox strPrompt, vbInformation, "Passorts expiry info"
End If

End Sub

Hoop this answers your question.

Wouter.
 
A

Alam

Hi,RadarEye
Thank you very mach it is working perfectly, if you don’t mind I want more
option with message box if you can add to message box more button (print the
list) if want the list in print of course it will be very useful command,
other wise I will press “OK†to close the message box.
More things the macro it is not staring automatically went I open the
workbook why?
Thank you for your help.


RadarEye said:
Hi Alam

Open tha VBA by pressing [Alt]+{F11].
Add the code below to "ThisWorkbook"

Private Sub Workbook_Open()
Dim datTestAgainst As Date
Dim strPrompt As String
Dim intRow As Integer
Dim blnPrompt As Boolean

datTestAgainst = DateAdd("M", 2, Date)
intRow = 2
strPrompt = "Date" & vbTab & "Name"
Do
If Cells(intRow, 4) < datTestAgainst Then
strPrompt = strPrompt & vbNewLine & Cells(intRow, 4).Value
& vbTab & Cells(intRow, 1)
blnPrompt = True
End If
intRow = intRow + 1
Loop Until IsEmpty(Cells(intRow, 4))

If blnPrompt Then
MsgBox strPrompt, vbInformation, "Passorts expiry info"
End If

End Sub

Hoop this answers your question.

Wouter.

Dear All
Please any one can help me.
If My Data Like
NAME PASSPORT NO. ISSUED DATE PASSPORTEXPIRY
DATE
LOUIS HENNERY B125556 5/5/2004 5/5/2007
VICTOR H. S A125586 1/9/2005 1/9/2008

I want when I open this data file, MsgBox showing the list name of staff
their passport is near or already .
Thanks
 
R

RadarEye

Hi Alam,

Change the code into:

Private Sub Workbook_Open()
Dim datTestAgainst As Date
Dim strPrompt As String
Dim intRow As Integer
Dim blnPrompt As Boolean
Dim intLayout As Integer
Dim strHeader As String
Dim lngFile As Long

datTestAgainst = DateAdd("M", 2, Date)
intRow = 2
strPrompt = "Date" & vbTab & "Name"
Do
If Cells(intRow, 4) < datTestAgainst Then
strPrompt = strPrompt & vbNewLine & _
Cells(intRow, 4).Value & vbTab & Cells(intRow, 1)
blnPrompt = True
End If
intRow = intRow + 1
Loop Until IsEmpty(Cells(intRow, 4))


If blnPrompt Then
strHeader = "Print Passorts expiry info"
intLayout = vbYesNo + vbInformation
If MsgBox(strPrompt, intLayout, strHeader) = vbYes Then
lngFile = FreeFile
Open "LPT1:" For Output As #lngFile
Print #lngFile, strPrompt
Close #lngFile
End If
End If

End Sub


Special attantion for
Open "LPT1:" For Output As #lngFile

If you are usung a netwokprinter you will have to find out it's name.
Go to the Immediate window and type
? activePrinter
Hit enter
the reply will be something like
\\PrintServer\Printer1 on Ne)1:

replace the line above with
Open "\\PrintServer\Printer1 on Ne)1:" For Output As #lngFile


If you are using a USB printer I can not help you at this moment.

Hi,RadarEye
Thank you very mach it is working perfectly, if you don't mind I want more
option with message box if you can add to message box more button (print the
list) if want the list in print of course it will be very useful command,
other wise I will press "OK" to close the message box.
More things the macro it is not staring automatically went I open the
workbook why?
Thank you for your help.



RadarEye said:
Open tha VBA by pressing [Alt]+{F11].
Add the code below to "ThisWorkbook"
Private Sub Workbook_Open()
Dim datTestAgainst As Date
Dim strPrompt As String
Dim intRow As Integer
Dim blnPrompt As Boolean
datTestAgainst = DateAdd("M", 2, Date)
intRow = 2
strPrompt = "Date" & vbTab & "Name"
Do
If Cells(intRow, 4) < datTestAgainst Then
strPrompt = strPrompt & vbNewLine & Cells(intRow, 4).Value
& vbTab & Cells(intRow, 1)
blnPrompt = True
End If
intRow = intRow + 1
Loop Until IsEmpty(Cells(intRow, 4))
If blnPrompt Then
MsgBox strPrompt, vbInformation, "Passorts expiry info"
End If
Hoop this answers your question.

- Tekst uit oorspronkelijk bericht weergeven -
 
Y

Yousoft

Hi RadarEye
Hi,
I need more thing if it is possible, I want Automatic Popup message when or
before one month of expiry date due.
Thanks


RadarEye said:
Hi Alam,

Change the code into:

Private Sub Workbook_Open()
Dim datTestAgainst As Date
Dim strPrompt As String
Dim intRow As Integer
Dim blnPrompt As Boolean
Dim intLayout As Integer
Dim strHeader As String
Dim lngFile As Long

datTestAgainst = DateAdd("M", 2, Date)
intRow = 2
strPrompt = "Date" & vbTab & "Name"
Do
If Cells(intRow, 4) < datTestAgainst Then
strPrompt = strPrompt & vbNewLine & _
Cells(intRow, 4).Value & vbTab & Cells(intRow, 1)
blnPrompt = True
End If
intRow = intRow + 1
Loop Until IsEmpty(Cells(intRow, 4))


If blnPrompt Then
strHeader = "Print Passorts expiry info"
intLayout = vbYesNo + vbInformation
If MsgBox(strPrompt, intLayout, strHeader) = vbYes Then
lngFile = FreeFile
Open "LPT1:" For Output As #lngFile
Print #lngFile, strPrompt
Close #lngFile
End If
End If

End Sub


Special attantion for
Open "LPT1:" For Output As #lngFile

If you are usung a netwokprinter you will have to find out it's name.
Go to the Immediate window and type
? activePrinter
Hit enter
the reply will be something like
\\PrintServer\Printer1 on Ne)1:

replace the line above with
Open "\\PrintServer\Printer1 on Ne)1:" For Output As #lngFile


If you are using a USB printer I can not help you at this moment.

Hi,RadarEye
Thank you very mach it is working perfectly, if you don't mind I want more
option with message box if you can add to message box more button (print the
list) if want the list in print of course it will be very useful command,
other wise I will press "OK" to close the message box.
More things the macro it is not staring automatically went I open the
workbook why?
Thank you for your help.



RadarEye said:
Open tha VBA by pressing [Alt]+{F11].
Add the code below to "ThisWorkbook"
Private Sub Workbook_Open()
Dim datTestAgainst As Date
Dim strPrompt As String
Dim intRow As Integer
Dim blnPrompt As Boolean
datTestAgainst = DateAdd("M", 2, Date)
intRow = 2
strPrompt = "Date" & vbTab & "Name"
Do
If Cells(intRow, 4) < datTestAgainst Then
strPrompt = strPrompt & vbNewLine & Cells(intRow, 4).Value
& vbTab & Cells(intRow, 1)
blnPrompt = True
End If
intRow = intRow + 1
Loop Until IsEmpty(Cells(intRow, 4))
If blnPrompt Then
MsgBox strPrompt, vbInformation, "Passorts expiry info"
End If
Hoop this answers your question.

Dear All
Please any one can help me.
If My Data Like
NAME PASSPORT NO. ISSUED DATE PASSPORTEXPIRY
DATE
LOUIS HENNERY B125556 5/5/2004 5/5/2007
VICTOR H. S A125586 1/9/2005 1/9/2008
I want when I open this data file, MsgBox showing the list name of staff
their passport is near or already .
Thanks- Tekst uit oorspronkelijk bericht niet weergeven -

- Tekst uit oorspronkelijk bericht weergeven -
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top