Solved

Do Until Loop VBA Question

Posted on 2013-10-23
12
822 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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
 
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

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

It’s been over a month into 2017, and there is already a sophisticated Gmail phishing email making it rounds. New techniques and tactics, have given hackers a way to authentically impersonate your contacts.How it Works The attack works by targeti…
As tax season makes its return, so does the increase in cyber crime and tax refund phishing that comes with it
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …

749 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