Calculate the number of weeks in a month 2

[jofarrell]

Anyone know if there is an easy way to calculate the number of weeks in a month. For example in June 1-2 was a Friday and Saturday making up week 1 then the 4 weeks after leaving 5 months for June. Basically same for July .. I would like to be able to call on week 1 instead of
June 1 - June 2, week 2 (June 3 - June 9) Less chance of user error that way.

Any ideas?

Joanne

 

[jofarrell]

Ohh life is always interesting .. especially on a Friday the 13th

Thanks for all the help to both you and MichaelRed. Its always interesting to see how others perceive a problem and the different thought processes involved in solving it.

Your aid has been much appreciated.

Joanne

 

[MichaelRed]

scorpio66,

Jo didn't ask for a function which counted the number of Saturdays in a month, she asked for a function which returned the number of distinct weeks which occurs in a month.

I would offer a different opinion. Jo asked for a function/method/procedure ... which returns a value indicating the number of 'things' in a context. According to her 'amplifications, the 'things' are the periords within a month which end on Saturdays and any partial periods which start within the month but are not 'closed' by a Saturday. My interpertation / analysis simply uses the 'statements' she supplied and reitterated them with somewhat different ordering. Just another expression for the ' ... number of distinct weeks ... ". If she were to change the "ending" day for the period, many/most of the function(s) would need to be reformulated to account for the difference.



Your code doesn't do that.

Well, O.K. I missed a detail or two on the last version. mew culpa. It can be (has been) "fixed" - just another bug in another procedure in another app ... Perhaps it would have been "better" to have waited until the bright light of day to run some tests, but at the dark hour it "looked" quite good.

Public Function nRptPer(DateIn As Date) As Integer

    Dim nDays As Integer    'Number of days in the month
    Dim Mnth As Integer
    Dim Yr As Integer
    Dim StDt As Date
    Dim EndDt As Date
    Dim AddPer As Integer   'Number of periods to 'add'

    Mnth = Month(DateIn)                    'Just get the Month of interest
    Yr = Year(DateIn)                       'And the year

    StDt = DateSerial(Yr, Mnth, 1)          'Last date of previous Month
    EndDt = DateSerial(Yr, Mnth + 1, 0)     'Last date of Month of Interest

    nDays = DateDiff("d", StDt, EndDt) + 1
    'nDays = Day(EndDt)     'Alternative calc of number of days in Month.

    Select Case nDays
        Case Is = 28        'Only the 'Ususal' Fed.  ALWAYS -1
            If (Weekday(StDt) = vbSunday) Then
                AddPer = -1
            End If

        Case Is = 29        'Never needs an adjustment!

        Case Is = 30
            If (Weekday(StDt) = vbSaturday) Then
                AddPer = 1
            End If

        Case Is = 31
            If (Weekday(StDt) > vbThursday) Then
                AddPer = 1
            End If
    
    End Select

    nRptPer = 5 + AddPer

End Function

While I apologise for the buggy code, it was really only intended as an example of approaching the same problem from the 'old' perspective which placed more value on machine resources than 'programmer' resources. My point was that it is possible to do this problem with very little "calculation".

It could be done with only calculating the number of days in Feburary of the year and the weekday of the first day of the month:

Public Function WksinMnth_L(DateIn As Date) As Integer

    Dim MnthDays(12) As Integer     'Array to hold the number of days in the month
    Dim DayFirst As Integer         'Weekday of the first of the month
    Dim AddPer As Integer           'Number of Periods / weeks to Adjust the standard (5)

    'Days in the Month
    MnthDays(1) = 31        'Jan
    MnthDays(2) = Day(DateSerial(Year(DateIn), 3, 0))
    MnthDays(3) = 31        'Mar
    MnthDays(4) = 30        'Apr
    MnthDays(5) = 31        'May
    MnthDays(6) = 30        'Jun
    MnthDays(7) = 31        'Jul
    MnthDays(8) = 31        'Aug
    MnthDays(9) = 30        'Sep
    MnthDays(10) = 31       'Oct
    MnthDays(11) = 30       'Nov
    MnthDays(12) = 31       'Dec

    DayFirst = Weekday(DateSerial(Year(DateIn), Month(DateIn), 1))

    Select Case MnthDays(Month(DateIn))
        Case Is = 28        'Only the 'Ususal' Fed.  ALWAYS -1
            If (DayFirst = vbSunday) Then
                AddPer = -1
            End If

        Case Is = 29        'Never needs an adjustment!

        Case Is = 30
            If (DayFirst = vbSaturday) Then
                AddPer = 1
            End If

        Case Is = 31
            If (DayFirst > vbThursday) Then
                AddPer = 1
            End If
    
    End Select

    WksinMnth_L = 5 + AddPer

End Function

MichaelRed
mred@att.net

There is never time to do it right but there is always time to do it over

 

[scorpio66]

I would dispute that your solution is more efficient in terms of machine resources. Compared to my final solution (now thats a dangerous turn of phrase):

(simplified)
mine: 2 DateSerials, 1 DateDiff
yours: 2 DateSerials, 1 DateDiff, 1 Case statement

Its more difficult to do a comparison between your code and my more 'mathematical' solution, and also, I suspect, moot. All solutions will be fast enough.

In terms of programmer resources, this forum demonstrates that there is a significant amount of programmer resource at your disposal, should you require it. Admittedly, it can sometimes be a slow solution, but it does have the advantage of generally being well-informed.

However, your code does have one advantage - legibility. Compared to the 'mathematical' solution, your code is very easy to understand. Its a tough call as to how important this is, but my take on it is that in a commercial development environment, you shouldn't 'dumb down' the code, you should 'smart up' the developers. I understand that this is not necessarily the case here, and accept the criticisms you have made.

Also, with a comment or 2, even my obfuscated code could almost become understandable

Chaz