code error

awake2424

Registered User.
Local time
Today, 16:32
Joined
Oct 31, 2007
Messages
479
I am using the function below to calculate a field that excludes weekends and holidays. The weekends are excluded as it is now, but when I try to add in code to exclude holidays I am getting errors. The code for the holidays is in bold and a couple of the errors are Loop without Do so I remove the Loop then I get a Else without If. It's very close but I can not seem to fix this issue. Thank you :).

VB
Code:
 Option Compare Database

Public Function WorkingDays(Due_Date As Date, Result_Date As Date) As Integer
'-- Return the number of WorkingDays between Due_Date and Result_Date
On Error GoTo err_workingDays

Dim intCount As Integer

If IsDate(Due_Date) And IsDate(Result_Date) Then
   If Result_Date >= Due_Date Then

      intCount = 0
      Do While Due_Date < Result_Date
         Due_Date = Due_Date + 1
         If Weekday(Due_Date, vbMonday) <= 5 Then
     
     '[B]-- Holiday code
            If Weekday(Due_Date, vbMonday) <= 5 And _
            IsNull(DLookup("[Description]", "Holidays", _
            "[Holiday] = " & Format(Due_Date, "\#mm\/dd\/yyyy\#;;;\N\u\l\l"))) Then

            intCount = intCount + 1
            Loop
         End If
      WorkingDays = intCount
   Else
      WorkingDays = -1  '-- To show an error
   
   End If
   
   Else
      WorkingDays = -1  '-- To show an error
End If

exit_workingDays:
   Exit Function [/B]

err_workingDays:
   MsgBox "Error No:    " & Err.Number & vbCr & _
   "Description: " & Err.Description
   Resume exit_workingDays

End Function
 
Readable code is maintainable code....

Try indenting your code properly and see if you can find your problem, I did the indenting for you
Code:
Public Function WorkingDays(Due_Date As Date, Result_Date As Date) As Integer
'-- Return the number of WorkingDays between Due_Date and Result_Date
On Error GoTo err_workingDays

Dim intCount As Integer

If IsDate(Due_Date) And IsDate(Result_Date) Then
   If Result_Date >= Due_Date Then

      intCount = 0
      Do While Due_Date < Result_Date
         Due_Date = Due_Date + 1
         If Weekday(Due_Date, vbMonday) <= 5 Then
     '-- Holiday code
             If Weekday(Due_Date, vbMonday) <= 5 And _
                 IsNull(DLookup("[Description]" _
                              , "Holidays" _
                              , "[Holiday] = " & Format(Due_Date, "\#mm\/dd\/yyyy\#;;;\N\u\l\l"))) Then
                 intCount = intCount + 1
             Loop
         End If
         WorkingDays = intCount
      Else
          WorkingDays = -1  '-- To show an error
   
      End If
   Else
      WorkingDays = -1  '-- To show an error
   End If

exit_workingDays:
   Exit Function 

err_workingDays:
   MsgBox "Error No:    " & Err.Number & vbCr & _
   "Description: " & Err.Description
   Resume exit_workingDays

End Function
 
try this, I notice you have some If's with no End If's, I think that will work only if you follow the Then with a colon :
Not sure you have the day incrementer in the right place, you may have to sense check the result when you get it to work, could try moving it to just before the 'Loop' if the result seems a day out

Code:
If IsDate(Due_Date) And IsDate(Result_Date) Then
   If Result_Date >= Due_Date Then
 
      intCount = 0
      Do While Due_Date < Result_Date
         Due_Date = Due_Date + 1
     '-- Holiday code
           If Weekday(Due_Date, vbMonday) <= 5 And _
           IsNull(DLookup("[Description]", "Holidays", _
            "[Holiday] = " & Format(Due_Date, "\#mm\/dd\/yyyy\#;;;\N\u\l\l"))) Then: intCount = intCount + 1
      Loop
 
      WorkingDays = intCount
      Else
          WorkingDays = -1  '-- To show an error
 
   End If
 
   Else
      WorkingDays = -1  '-- To show an error
End If

David
 
As to your function, add the Option Explicit to your code module.
Option Compare Database
Option Explicit

Used indention to align each If with its corresponding Else and End If
On line 100 - your Loop is in the middle of a paired If / End If
That means the code is trying to exit (the loop) before the If / End If has completed.

The loop structure can't interrupt a nested If / End If
Code:
Option Compare Database
Option Explicit
Public Function WorkingDays(Due_Date As Date, Result_Date As Date) As Integer
      '-- Return the number of WorkingDays between Due_Date and Result_Date
10    On Error GoTo err_workingDays

      Dim intCount As Integer

20    If IsDate(Due_Date) And IsDate(Result_Date) Then
30       If Result_Date >= Due_Date Then

40          intCount = 0
50          Do While Due_Date < Result_Date
60             Due_Date = Due_Date + 1
70             If Weekday(Due_Date, vbMonday) <= 5 Then
           
           '-- Holiday code
80                If Weekday(Due_Date, vbMonday) <= 5 And _
                      IsNull(DLookup("[Description]", "Holidays", _
                      "[Holiday] = " & Format(Due_Date, "\#mm\/dd\/yyyy\#;;;\N\u\l\l"))) Then

90                    intCount = intCount + 1
100               Loop ' loop can't be in the middle of a nested if/end if
110               End If
120         WorkingDays = intCount
130       Else
140         WorkingDays = -1  '-- To show an error
         
150       End If
         
160   Else
170         WorkingDays = -1  '-- To show an error
180   End If

exit_workingDays:
190      Exit Function

err_workingDays:
200      MsgBox "Error No:    " & Err.Number & vbCr & _
         "Description: " & Err.Description
210      Resume exit_workingDays

End Function

LOL, I am so slow, two people responded in the 5 minutes I edited the code!
 
I am able to use the function now, thank you.

The database is connected to a sharepoint site and when the user enters a Result_date in there TAT on the databas does not populate. However, if the user enters the Result_Date in the database TAT populates. How can I make it populate when the field Result_Date has a value in it no matter if it is from sharepoint or the database? Thanks.

Code:
 Private Sub Result_Date_AfterUpdate()
    Me.TAT = WorkingDays(Due_Date, Result_Date)
End Sub
 

Users who are viewing this thread

Back
Top Bottom