Finding Fridays 2

[denniskb]

I'm looking for some VB code that will find the following Fridays from a given date in a cell.

> The first Friday following the given date

> The first Friday in the month of the given date

> The last Friday in the month of the given date

I have a fairly crude way to get the first but am having trouble with coding the others. Any suggestions will be gratefully considered. Dennis Kirk Engineering

http://www.ozemail.com.au/~denniskb

 

[BML]

Here's an attempt at the problem using functions in various cells. Hope this helps!

A1 is the current date.

A12 is the first Friday after the current date:
=A1+6-WEEKDAY(A1,1)

A16 is the first day of the current month:
=EOMONTH(A1,-1)+1

D16 is the first Friday of the current month:
=A16+6-WEEKDAY(A16)

A20 is the last day of the current month:
=EOMONTH(A1,0)

D20 is the last Friday of the current month:
=IF(MONTH(A20-1-WEEKDAY(A20))=MONTH(A20+6-WEEKDAY(A20)),A20+6-WEEKDAY(A20),A20-1-WEEKDAY(A20))

 

[Flareman]

This is not a VB script but if you check

http://www.geocities.com/flareman_xs/datePage.html

I have put up an Excel sheet which does this.

 

[denniskb]

Thank you BML and Flareman, both solutions work well and have solved the problem. While not VB I am more than happy with this solution and will incorporate it into my application. Dennis Kirk Engineering

http://www.ozemail.com.au/~denniskb

 

[Box]

There is a way to determine the day of the week with formulas. Let's say A12 is the date. Then just do a "mod(a12,7)". This will return a value from 0 to 6. With 0 being Sunday, and 6 being Saturday.

You could mod your current date. Then have a cell that subtracts that value from 5. Add this number back to your mod'd date, and you have the next Friday's date.

GB

 

[plawrence]

I'd love to be able to find Friday's faster and more frequently. They don't come often enough. :-D

 

[nineball]

The following formulas seem to work in Excel 2000

Enter a date in cell A1

Next Friday
=IF(WEEKDAY(A1,2)<5,A1+(5-WEEKDAY(A1,2)),A1+(12-WEEKDAY(A1,2)))

Last Friday of month
=IF(WEEKDAY(EOMONTH(A1,0),2)=5,EOMONTH(A1,0),IF(WEEKDAY(EOMONTH(A1,0),2)<5,EOMONTH(A1,0)-(WEEKDAY(EOMONTH(A1,0),2)+2),IF(WEEKDAY(EOMONTH(A1,0),2)>5,EOMONTH(A1,0)-(WEEKDAY(EOMONTH(A1,0),2)-5))))

First Friday of month
=IF(WEEKDAY(EOMONTH(A1,-1),2)=5,EOMONTH(A1,-1)+7,IF(WEEKDAY(EOMONTH(A1,-1),2)<5,EOMONTH(A1,-1)+5-(WEEKDAY(EOMONTH(A1,-1),2)),IF(WEEKDAY(EOMONTH(A1,-1),2)>5,EOMONTH(A1,-1)+(12-WEEKDAY(EOMONTH(A1,-1),2)))))

 

[denniskb]

Hi all, thanks for the help offered.

With the various tips provided I have managed to solve this one now, but in the worksheet, not in VBA.

If anyone wants it I will be happy to forward the spreadsheet. Contact me at denniskb@ozemail.com.au
Dennis Kirk Engineering

http://www.ozemail.com.au/~denniskb

 

[msmith]

Dennis,

If you or anyone else is interested, here are some VBA functions that do what you required. These can be used as worksheet functions in addition to being called from within a VBA procedure. Supply a valid date as the argument (or cell reference containing a date). These will convert a Date+Time input and return a Date only value. There are a couple of additional functions here that the others require but could also be used directly. The Demo_DateFunctions procedure just demonstrates usage of these functions.

Sub Demo_DateFunctions()
  MsgBox "First Friday after date: " & FirstFridayAfterDate(ActiveSheet.Range("A1"))
  MsgBox "First Friday of Month: " & FirstFridayOfMonth(ActiveSheet.Range("A1"))
  MsgBox "Last Friday of Month: " & LastFridayOfMonth(ActiveSheet.Range("A1"))
End Sub


Function FirstFridayAfterDate(ByVal DateVal As Date) As Date
Dim WkDay As Integer

  DateVal = Int(DateVal)
  WkDay = Weekday(DateVal)
  If WkDay = 6 Then
    FirstFridayAfterDate = DateVal + 7
  ElseIf WkDay = 7 Then
    FirstFridayAfterDate = DateVal + 6
  Else
    FirstFridayAfterDate = DateVal + 6 - WkDay
  End If
End Function


Function FirstFridayBeforeDate(ByVal DateVal As Date) As Date
Dim WkDay As Integer

  DateVal = Int(DateVal)
  WkDay = Weekday(DateVal)
  If WkDay = 7 Then
    FirstFridayBeforeDate = DateVal - 1
  Else
    FirstFridayBeforeDate = DateVal - (WkDay + 1)
  End If
End Function



Function FirstFridayOfMonth(ByVal DateVal As Date) As Date
Dim Mnth As Integer
Dim Yr As Integer
Dim DateTmp As Date

  DateVal = Int(DateVal)
  Mnth = DatePart("m", DateVal)
  Yr = DatePart("yyyy", DateVal)
  DateTmp = DateSerial(Yr, Mnth, 1)
  If Weekday(DateTmp) = 6 Then
    FirstFridayOfMonth = DateTmp
  Else
    FirstFridayOfMonth = FirstFridayAfterDate(DateTmp)
  End If
  
End Function


Function LastFridayOfMonth(ByVal DateVal As Date) As Date
Dim Mnth As Integer
Dim Yr As Integer
Dim DateTmp As Date

  DateVal = Int(DateVal)
  Mnth = DatePart("m", DateVal)
  Yr = DatePart("yyyy", DateVal)

  DateTmp = DateSerial(Yr, Mnth, DaysInMonth(Mnth, Yr))
  If Weekday(DateTmp) = 6 Then
    LastFridayOfMonth = DateTmp
  Else
    LastFridayOfMonth = FirstFridayBeforeDate(DateTmp)
  End If
  
End Function



Function DaysInMonth(ByVal Month As Integer, ByVal Year As Integer) As Integer

  Select Case Month
    Case 2
      If IsLeapYear(Year) Then
        DaysInMonth = 29
      Else
        DaysInMonth = 28
      End If
    Case 4, 6, 9, 11
      DaysInMonth = 30
    Case Else
      DaysInMonth = 31
  End Select
  
End Function


Function IsLeapYear(Year As Integer) As Boolean
  IsLeapYear = (Month(DateSerial(Year, 2, 29)) = 2)
End Function

Regards,
Mike