VBA to calculate payment day for salary (Access DB)

Question

I am programming an Access Payment Salary DB, and salaries should be paid the 14th every month. If it is a weekend, or a holiday, then is should be 13th, 12th, 11th, etc (the last workday before the 14th). Our weekends is on Friday and Saturday - Weekday(dteDate, vbSunday)

My challenge is that I don't get the correct value when the VBA does the calculation. First it checks if it is a weekend, then reduces one or two days (depends if it is a Saturday or Sunday), and then it should test if it is a holiday ([tblHoliday].[tblHoliday]). If yes, then reduce it with one day - until it is not a holiday again. Then it shall test if it is a weekend, again, if yes, reduce correct amount of days, and then test if it is a holiday again. If not, then return the date.

I am using this in the Compare Database

  Private Sub PeriodeEnd_Text_AfterUpdate()

Dim dtDate As Date
Dim testDate As Date

    dtDate = dhLastDayInMonth(Me.PeriodeEnd_Text) + 14
    testDate = LastWorkDay(dtDate)

Me.PaymentDay_Text = testDate

End Sub

And have this in a module

Function dhLastDayInMonth(Optional dtmDate As Date = 0) As Date
    ' Return the last day in the specified month.
    If dtmDate = 0 Then
        ' Did the caller pass in a date? If not, use
        ' the current date.
        dtmDate = Date
    End If
    dhLastDayInMonth = DateSerial(Year(dtmDate), _
     Month(dtmDate) + 1, 0)
End Function

     Public Function LastWorkDay(Dt As Date) As Date

   Dim Searching As Boolean
   Searching = True

   Do While Searching
      If Weekday(LastWorkDay, vbSunday) > 5 Then
         '-- Weekend day, back up a day
         LastWorkDay = LastWorkDay - 1
      Else
         If Weekday(LastWorkDay, vbSunday) > 5 Or _
            Not IsNull(DLookup("[HolidayDate]", "tblHoliday", _
                               "[HolidayDate] = " & Format(LastWorkDay, "\#mm\/dd\/yyyy\#;;;\N\u\l\l"))) Then
            '-- The above Format of LastWorkday works with US or UK dates!
            LastWorkDay = LastWorkDay - 1
         Else
            '-- The search is over
            Searching = False
         End If
      End If
    Loop
End Function

Dt is the parameter of your LastWorkDay function, but you never use it. You probably need to include the line LastWorkDay = Dt at the beginning of your loop or set it to use Dt throughout the function and then set LastWorkDay = Dt at the end. — OpiesDad
Hi, thanks for the help, and I tested it, but it fails. When the day ends up on a weekend and, and (in my case) the last workday before the weekend is Thursday, and if that is a holiday, the entire Access program ends up in a deadlock. I have to restart the program. But luckily, Dave's suggestions below is working. If you easily can see why my code is not working, it would be nice for my record. — Thomas Formo Riise

Dave Stokes Dave Stokes · Accepted Answer · 2016-07-22T15:09:41

I'm sure there are cleaner answers, but perhaps try this one?

Kind regards

Function WhenIsNextPayDate() As Date

Dim dteIn7days As Date
Dim dteTemp As Date
Dim intDayOfWeek As Integer
Dim blnNonPayDate As Boolean

'I have used the actual 2016 easter holiday dates in Oz and
'pretended that your pay day was actually the 28th (a Monday)
'We are imagining today is the 21st of March 2016 and
'that we would like to know the pay date at least a week ahead

dteIn7days = #3/21/2016# + 7

If DatePart("d", dteIn7days) = 28 Then

    'Keep going back in time until pay day is not Saturday, Sunday or a public holiday
    dteTemp = dteIn7days
    Do

        blnNonPayDate = False

        intDayOfWeek = DatePart("w", dteTemp)

        Select Case intDayOfWeek

            Case vbSaturday '7

                blnNonPayDate = True
            Case vbSunday '1

                blnNonPayDate = True
            Case Else

                '(I imagine you already have a function to test a date
                'in the public holiday table)
                'This is to illustrate the case of 2 public holidays
                'Easter friday and easter monday
                If dteTemp = #3/25/2016# Or dteTemp = #3/28/2016# Then

                    blnNonPayDate = True
                End If
        End Select

        If blnNonPayDate = False Then

            'Pay day - thursday 24th March 2016
            WhenIsNextPayDate = dteTemp
            Debug.Print WhenIsNextPayDate
            Exit Do
        Else

            'Keep going back in time
            dteTemp = dteTemp - 1
        End If
    Loop
End If

End Function

VBA to calculate payment day for salary (Access DB)

2 Answers