Code Snippets

Age

Excel user defined function - AGE

FirstDayOfTheMonth

Excel user defined function - DATEFIRST

LastDayOfTheMonth

Excel user defined function - DATELAST

Pause

This Pause for 5 seconds

Nexttime = Now() + TimeValue("00:00:05") 
Application.Wait Nexttime 

IsInThePast

Check if a date is in the past

Public Function IsInThePast(ByVal dtDate As Date) As Boolean 
   If (dtDate < VBA.Date()) Then 
      IsInThePast = True 
   Else 
      IsInThePast = False 
   End If 
End Function 

IsWorkday

This function determines whether a date falls on a weekday. If no date passed in, use today's date.
vbMonday = 2, vbSaturday = 7, vbSunday = 1

Public Function IsWorkday(Optional ByVal dteDate As Date) As Boolean 

   If CLng(dteDate) = 0 Then 
      dteDate = Date 
   End If 
    
   Select Case Weekday(dteDate) 
      Case vbMonday To vbFriday 
         IsWorkday = True 
      Case Else 
         IsWorkday = False 
   End Select 
End Function 

IsLeapYear

=VBA.Year(dtDate) Mod 4 = 0) And _ 
   (VBA.Year(dtDate) Mod 100 <> 0) Or (VBA.Year(dtDate) Mod 400 = 0)) 

WhichQuarter

Public Function WhichQuarter(ByVal dtDate As Date) As Integer 
Dim quarter As Integer 
   WhichQuarter = VBA.Int((VBA.Month(VBA.Date) -1) / 3) + 1 
End Function 

Time Loop

Public Sub TimeLoop() 
   Dim AbortTime As Date 
   
   AbortTime = Now + TimeValue("0:00:05")   ' Wait for 5 seconds  

   Do While (True) 
      'Code for one iteration goes here
      If (Now > AbortTime) Then 
         Exit Do 
      End If 
   Loop 
End Sub 

Anniversary

The following procedure finds the anniversary of a given date; that is, the next date on which it occurs.
If the anniversary has already occurred this year, the procedure returns the date of the anniversary in the next year.
This function finds the next anniversary of a date. If the date has already passed for this year, it returns the date on which the anniversary occurs in the following year.
The procedure determines the last day of the last year by using the DateSerial function, and then subtracts that date from the date that was passed in to the procedure.

Public Function Anniversary(ByVal dteDate As Date) As Date 
   Dim dteThisYear As Date 
    
   ' Find corresponding date this year.  
   dteThisYear = DateSerial(Year(Date), Month(dteDate), Day(dteDate)) 
   ' Determine whether it's already passed. 
   If dteThisYear < Date Then 
      Anniversary = DateAdd("yyyy", 1, dteThisYear) 
   Else 
      Anniversary = dteThisYear 
   End If 
End Function 

DayOfTheYear

This function takes a date as an argument and returns the day number for that year.
If the dteDate argument is omitted, the function uses the current date.
Using the DateDiff function to determine the number of years between today and a birthdate doesn't always give a valid result because the DateDiff function rounds to the next year.
If a person's birthday hasn't yet occurred, using the DateDiff function will make the person one year older than he or she actually is.
To remedy this situation, the procedure checks to see whether the birthday has already occurred this year, and if it hasn't, it subtracts 1 to return the correct age.

Public Function DayNumberInYear(Optional ByVal dteDate As Date) As Long 
    
   ' If dteDate argument has not been passed, dteDate is  
   ' initialized to 0 (or December 30, 1899, the date equivalent of 0  

   If CLng(dteDate) = 0 Then 
      dteDate = VBA.Date() 
   End If 
    
   ' Calculate the number of days that have passed since  
   ' December 31 of the previous year.  
   DayOfYear = Abs(DateDiff("d", dteDate, VBA.DateSerial(Year(dteDate) - 1, 12, 31))) 
       
End Function