Solved

Do Until Loop VBA Question

Posted on 2013-10-23
12
795 Views
Last Modified: 2013-11-27
Hi Experts,

In the code below, the Public Function Work_Days works perfectly and calculates the number of days between two dates excluding weekends and holidays.  

I am trying to write a function which essentially does this:

I give the function an end date and tell the function to subtract 10 work days to give me a start date.  My attempt is the code below (Public Function Work_Days_Subtract()).  It is getting stuck on 'Loop' with a compile error of 'Loop without Do'.  This is my first attempt at writing this type of loop code by myself, but I thought the 'Do Until' would couple with the loop...any pointers would be appreciated.
Thanks!


Option Compare Database
Option Explicit

Public Function Work_Days(BegDate As Variant, EndDate As Variant) As Integer

' "Calculating the workdays between Dates"
' Note that this function accounts for holidays.

Dim WholeWeeks As Variant
Dim DateCnt As Variant
Dim EndDays As Integer

BegDate = DateValue(BegDate)
EndDate = DateValue(EndDate)
DateCnt = BegDate
EndDays = 0

Do While DateCnt <= EndDate

If Not IsNull(DLookup("Holiday", "t_Holiday_Dates", "[Holiday]=#" & DateCnt & "#")) Then
EndDays = EndDays - 1
End If

If Format(DateCnt, "ddd") <> "Sun" And _
Format(DateCnt, "ddd") <> "Sat" Then
EndDays = EndDays + 1
End If
DateCnt = DateAdd("d", 1, DateCnt)
Loop
Work_Days = EndDays

End Function



Public Function Work_Days_Subtract() As Date

Dim INumDaysToSubtract As Integer
Dim INumCalendarDays As Integer
Dim StartDate As Date
Dim EndDate As Date

INumDaysToSubtract = 10
INumCalendarDays = -20

EndDate = DLookup("MaxOfDataDate", "q_DataDate_MAX")
StartDate = DateAdd("d", INumCalendarDays, EndDate)

Do Until Work_Days_Subtract = INumDaysToSubtract
    If Work_Days(StartDate, EndDate) = INumDaysToSubtract Then
        Work_Days_Subtract = StartDate
        Exit Do
        Else: INumCalendarDays = INumCalendarDays - 1
        StartDate = DateAdd("d", INumCalendarDays, EndDate)
        Loop
    End If
       
End Function
0
Comment
Question by:grmcra
12 Comments
 
LVL 20

Expert Comment

by:thehagman
ID: 39595626
The loop looks misplaced inside the if/end if block
0
 
LVL 11

Expert Comment

by:SeanStrickland
ID: 39595735
This should fix it.
Regards,
Sean

Public Function Work_Days_Subtract() As Date

Dim INumDaysToSubtract As Integer
Dim INumCalendarDays As Integer
Dim StartDate As Date
Dim EndDate As Date

INumDaysToSubtract = 10
INumCalendarDays = -20

EndDate = DLookup("MaxOfDataDate", "q_DataDate_MAX")
StartDate = DateAdd("d", INumCalendarDays, EndDate)

Do Until Work_Days_Subtract = INumDaysToSubtract
    If Work_Days(StartDate, EndDate) = INumDaysToSubtract Then
        Work_Days_Subtract = StartDate
        Exit Do
    Else
        INumCalendarDays = INumCalendarDays - 1
        StartDate = DateAdd("d", INumCalendarDays, EndDate)
    End If
Loop
        
End Function

Open in new window

0
 

Author Comment

by:grmcra
ID: 39601810
Hi Experts,

I made the above correction, however, when I try to use the function, the database gets stuck and I have to force close the database ...I have attached a sample database.  I am trying to use the function in the query called q_3_Daily_Count.  The module referenced in this question is under:  Work_Days - Counts business days
Expert-Exchange-Version.zip
0
 
LVL 26

Assisted Solution

by:Nick67
Nick67 earned 200 total points
ID: 39607023
When you build any loop, it will run on infinitely until the condition is met

Do Until Work_Days_Subtract = INumDaysToSubtract
    If Work_Days(StartDate, EndDate) = INumDaysToSubtract Then
        Work_Days_Subtract = StartDate
        Exit Do
    Else
        INumCalendarDays = INumCalendarDays - 1
        StartDate = DateAdd("d", INumCalendarDays, EndDate)
    End If
Loop

Open in new window

If this never happens

Work_Days_Subtract = INumDaysToSubtract

your loop will never quit.  CTRL-BREAK  (Upper right on keyboard) will break the code, so you can end it.

There's a bunch of ways to build safety in.
How many times should the code EVER loop?
Put in an incrementer (X) and bump it up once, each loop and bail if it gets too big:
Dim x as integer
x = 0
Do Until Work_Days_Subtract = INumDaysToSubtract or X > 1000 'or whatever
    If Work_Days(StartDate, EndDate) = INumDaysToSubtract Then
        Work_Days_Subtract = StartDate
        Exit Do
    Else
        INumCalendarDays = INumCalendarDays - 1
        StartDate = DateAdd("d", INumCalendarDays, EndDate)
    End If
    x = x + 1
Loop

Open in new window


Now the code will not run away infinitely
0
 
LVL 20

Expert Comment

by:ElrondCT
ID: 39607168
That's a huge database. And unfortunately when I try to open it, I'm getting an "unrecognized database format" error.

Can you post your actual code here?
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 20

Assisted Solution

by:ltlbearand3
ltlbearand3 earned 100 total points
ID: 39607694
The problem with all the code so far is that you want to go back 10 business days, but you start checking on how far back you are 20 days in the past.  The code then keeps taking one day away and checking if is 10 days in the past.  By definition, it can never find a match since you started too far in the past.  Try this piece of code.  It goes back the 10 days in the past to start checking plus uses a simple calculation to add the number of weekends if the number of days is even multiple of 7.  It then keeps moving one day back until it has found the right match.
Public Function Work_Days_Subtract() As Date
    Dim INumDaysToSubtract As Integer
    Dim intNonWeekendDays As Integer
    Dim StartDate As Date
    Dim EndDate As Date

    INumDaysToSubtract = 10

    ' Find End Date to use
    EndDate = DLookup("MaxOfDataDate", "q_DataDate_MAX")
    
    ' Calculate our Start Date
    ' First determine how far back to go by dividing the Number of Days by 7 -- INumDaysToSubtract / 7
    ' Use the Int function to drop any remainder--Int(INumDaysToSubtract / 7)
    ' Now multiple by 2 for Sat & Sun--(Int(INumDaysToSubtract / 7) * 2
    ' This is the number of weekend days in the number of days to subtract
    ' Now add back to the original number for the number of business days minues holidays or other potential weekend days
    ' subtract one to not include the start Date itself.
    ' This just gives a good starting point.  Now we just need to work back to find any other
    ' weekend day or holidays
    intNonWeekendDays = INumDaysToSubtract + (Int(INumDaysToSubtract / 7) * 2) - 1
    StartDate = DateAdd("d", -intNonWeekendDays, EndDate)


    Do Until Work_Days(StartDate, EndDate) = INumDaysToSubtract
        ' Move back one more day
        StartDate = DateAdd("d", -1, StartDate)
    Loop

    Work_Days_Subtract = StartDate
       
End Function

Open in new window


-Bear
0
 
LVL 21

Accepted Solution

by:
Boyd (HiTechCoach) Trimmell, Microsoft Access MVP earned 100 total points
ID: 39607876
I need to add or subtract workdays from a date regularly. I use  a function fAddWorkdays() that will allow me to pass parameters so it can be easily reused. You pass a start date and the number of days to add or subtract.

You would call it like this:
=fAddWorkdays(DLookup("MaxOfDataDate", "q_DataDate_MAX"), -10)

Open in new window


I have put the code into your sample database and it is working.

TIP: Compact your database before posting. It went from 180+ meg to 3+ meg.

See attached:
Expert-Exchange-Version-HiTechCo.zip
0
 
LVL 40

Assisted Solution

by:Vadim Rapp
Vadim Rapp earned 100 total points
ID: 39609099
As a general comment, your solution does not take into account the holidays. Here's what we are using. It's implemented in sql server, but hopefully the logic is clear.
CREATE TABLE [WorkDays] (
	[date] [datetime] NOT NULL PRIMARY KEY,
	[workday] [bit] NOT NULL DEFAULT (1),
	[workday_index] [int] NULL 
GO

-- fill the above table programmatically, then manually specify the holidays

CREATE function WorkDateAdd(@Date as datetime, @Num as integer) returns datetime begin

declare @d datetime
select @d=w2.[date]
from workdays w2 join workdays w1
on w2.workday=1
and w2.workday_index-w1.workday_index=@num
where w1.[date]=cast(floor(cast(@date as float)  ) as datetime)

return @d
end
GO

/*
The column workday_index is there to speed up the calculations. It has to be 
re-populated whenever the workdays are changed (such as when the company 
determines the holiday dates for the next year), by the following script:
*/

update workdays set workday_index=null

declare c cursor local fast_forward for
select [date],workday from workdays  order by 1
declare @i int, @d datetime, @w bit
select @i=0
open c
fetch c into @d,@w
while @@fetch_status=0 begin
	if @w=1 set @i=@i+1
	update workdays set workday_index=@i where [date]=@d
	fetch c into @d,@w
end
close c
deallocate c

Open in new window

0
 
LVL 26

Assisted Solution

by:Nick67
Nick67 earned 200 total points
ID: 39609102
Given that you have a working function that will calculate the workday interval between two dates, I'd be tempted to use it.  Here's a function that takes two inputs: How many workdays previous you want, and what date you want that previous to, and returns a date:
Public Function WorkDaysPrevious(Previous as Integer, StartDate as Date) As Date

'ok, we have Public Function Work_Days, which will calculate how many workdays between two given dates and it works
'so let's not re-invent the wheel

'Previous is the interval we want
'so we want an iteration that will call Work_Days until Work_Days =  Previous
'now, worst case scenario is that each work week is only 3 days long

Dim StartPoint as Integer
Dim BegDate as Date
Dim Done as boolean

'Break Previous into 3 day 'weeks'
StartPoint = CInt(Previous/3) +1 'round it off, but bump it by one just in case
StartPoint = StartPoint * 7 'cause there are 7 days per week!

'StartPoint is far enough in the past that walking forward we'll get our answer
'Maybe too far for optimum performance
'Adjust as you think needful!

'initialize variables
Done = False
BegDate = DateAdd("d", -1 * StartPoint, StartDate)
'BegDate is before start date
'Let's say Previous was 15
'StartPoint would be ((15/3)+1)*7
'Or 42 days
'For sure, as we walk forward from 42 calendar days before our date _
'we'll hit 15 workdays before our date in the Previous =  15 scenario!

Do Until Done = True or BegDate = StartDate ' get an answer or bail when the loop is no longer logical!
    Done = (Work_Days(BegDate, StartDate) = Previous)
    if Done = False then
        'step forward a day and try again
	BegDate = DateAdd("d", 1, BegDate)
    End If
Loop

WorkDaysPrevious = BegDate

End Function

Open in new window

0
 

Author Closing Comment

by:grmcra
ID: 39609155
Wow, I'm learning sooooo much from these posts, thank you!!!
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

The System Center Operations Manager 2012, known as SCOM, is a part of the Microsoft system center product that provides the user with infrastructure monitoring and application performance monitoring. SCOM monitors:   Windows or UNIX/LinuxNetwo…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …
In Microsoft Access, learn how to use Dlookup and other domain aggregate functions and one method of specifying a string value within a string. Specify the first argument, which is the expression to be returned: Specify the second argument, which …

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now