Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
Date count to exclude weekends
Hi all I us the routine below to allow 31 days before a workbook becomes unavailable. Presently , it counts a straight 31 days against the computer clock form the day the workbook was first used. I'd like if possible to have this exclude weekends for the count , so that that the routine only counts strictly working days (Monday - Friday) in the 31 allowed. Can someone advise? Here's the routine : Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 31 Sub TB() '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''' ' TB ' This procedure uses a defined name to store this workbook's ' expiration date. If the expiration date has passed, a ' MsgBox is displayed and this workbook is closed. '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''' Dim ExpirationDate As String Dim NameExists As Boolean On Error Resume Next ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2) If Err.Number < 0 Then ''''''''''''''''''''''''''''''''''''''''''' ' Name doesn't exist. Create it. ' If the defined name didn't exist, ' Save the workbook to establish the newly created name. ''''''''''''''''''''''''''''''''''''''''''' If NameExists = False Then ExpirationDate = CStr(DateSerial(Year(Now), _ Month(Now), Day(Date) + C_NUM_DAYS_UNTIL_EXPIRATION)) ThisWorkbook.Names.Add Name:="ExpirationDate", _ RefersToLocal:=Format(ExpirationDate, "short date"), _ Visible:=False 'False for final edition. ThisWorkbook.Save 'saves on first open but not subsequent openings End If Else NameExists = True End If '''''''''''''''''''''''''''''''''''''''''''''''''' '''' ' If the today is past the expiration date, close the ' workbook. Give a countdown from 3 days to closure. '''''''''''''''''''''''''''''''''''''''''''''''''' '''' If CDate(Date) = (CDate(ExpirationDate) - 3) Then MsgBox "Your trial period will expire in 3 days. ", vbExclamation End If If CDate(Date) = (CDate(ExpirationDate) - 2) Then MsgBox "Your trial period will expire in 2 days ", vbExclamation End If If CDate(Date) = (CDate(ExpirationDate) - 1) Then MsgBox "Your trial period will expire in 1 day", vbExclamation End If If CDate(Now) CDate(ExpirationDate) Then MsgBox "Your trial period has now expired", vbExclamation ThisWorkbook.Close savechanges:=False End If End Sub Grateful for any assistance. Best Wishes |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Exclude Weekends | Charts and Charting in Excel | |||
How do I set up a calculation to exclude weekends? | Excel Worksheet Functions | |||
Date Calculation to exclude weekends | Excel Worksheet Functions | |||
calculation to exclude weekends | Excel Worksheet Functions | |||
Schedule to exclude weekends and holidays | Excel Discussion (Misc queries) |