ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   VBA FOR expiry Date (https://www.excelbanter.com/excel-programming/401307-vba-expiry-date.html)

Alam

VBA FOR expiry Date
 
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


Don Guillett

VBA FOR expiry Date
 
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

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Alam" wrote in message
...
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



RadarEye

VBA FOR expiry Date
 
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.

On 18 nov, 11:28, Alam wrote:
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



Alam

VBA FOR expiry Date
 
Hi,RadarEye
Thank you very mach it is working perfectly, if you dont 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" wrote:

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.

On 18 nov, 11:28, Alam wrote:
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




RadarEye

VBA FOR expiry Date
 
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.

On 19 nov, 09:25, Alam wrote:
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" wrote:
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.


On 18 nov, 11:28, Alam wrote:
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 -



Yousoft

VBA FOR expiry Date popup Msgbox
 
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" wrote:

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.

On 19 nov, 09:25, Alam wrote:
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" wrote:
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.


On 18 nov, 11:28, Alam wrote:
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 -





All times are GMT +1. The time now is 10:09 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com