Case loop

[hgus393]

Hi all,
I am trying to write some code to populate a table with the nearest 65 working days from a starting point. However since the code ignores Saturdays and Sundays it does not populate the table with 65 days only with 65 days -(minus) Saturdays and Sundays... Does anyone know how to get around that?

Cheers Rob

Sub Workdays()
Dim dtDate As Date
    Dim i As Integer
    Dim rs As Recordset
    Dim r As Integer
Dim Newdate As Date
    dtDate = InputBox("Import Date: (YYYY-MM-DD):", "Hold on...!")
           Set rs = CurrentDb.OpenRecordset("Buckets")
      r = 65
 
    For i = 1 To r
 
 
Select Case (Weekday(dtDate + i))
Case Is = vbSunday
Case Is = vbSaturday
Case Else
Newdate = DateAdd("d", i, dtDate)
rs.AddNew
        rs!Bucket = Newdate
        rs.Update
End Select
 
 
     Next i
 
End Sub

 

[JamesMcS]

It's because no matter what the day, i is still being incremented by 1 - but your recordset only gets a new record when it's not a saturday or sunday.

Create another variable that only gets incremented in the "Case Else" part of your loop and use that to add the date.

 

[JamesMcS]

Instead of your for loop, use a do while:

i=1
Do while i <=65
Select Case (Weekday(dtDate + i))
Case Is = vbSunday
Case Is = vbSaturday
Case Else
 Newdate = DateAdd("d", i, dtDate)
 rs.AddNew
        rs!Bucket = Newdate
        rs.Update
 i=i+1
End Select
Loop

Also worth mentioning that setting i as 1 will always mean that the date loop will start from tomorrow. Setting it to 0 will include today's date in your recordset.

 

[vbaInet]

Decrease i by 1 for Saturday or Sunday.

 

[JamesMcS]

Yeah I thought that too - but what happens if the first day is a sat/sun? i will become 0, will that knacker the for loop?

 

[vbaInet]

Oops... yes it may lead to an endless loop. Based on the OP's original code you can increment r by 1. Your code works too.

 

[JamesMcS]

Loving the endless loops - they make it look to your boss like your PC is working REALLY hard

 

[vbaInet]

Real time processing...

 

[JamesMcS]

Also for neatness I would have gone for

i=1
Do while i <=65
If Weekday(dtDate + i) Is <> vbStaturday or Weekday(dtDate + i) <>vbSunday Then
Newdate = DateAdd("d", i, dtDate)
 rs.AddNew
rs!Bucket = Newdate
rs.Update
 i=i+1
Else
Loop

If it works, that was a bit of aircode

 

[JamesMcS]

Real time processing...

Keeping it real... time

 

[hgus393]

Hi,

Used some of your code. Kept the Case Select (somewhat faster).. ended up with using recordcount as loop indicator. Thanks for your help (see code below)

Sub Workdays()
Dim dtDate As Date
    Dim i As Integer
    Dim rs As Recordset
    Dim r As Integer
Dim Newdate As Date
    dtDate = InputBox("Import Date: (YYYY-MM-DD):", "Hold on...!")
           Set rs = CurrentDb.OpenRecordset("Buckets")
 
Do While rs.RecordCount < 65
i = i + 1
Select Case (Weekday(dtDate + i))
Case Is = vbSunday
Case Is = vbSaturday
Case Else
Newdate = DateAdd("d", i, dtDate)
rs.AddNew
        rs!Bucket = Newdate
        rs.Update
End Select
Loop
End Sub

Cheers
Rob

 

[JamesMcS]

That'd work... if 'buckets' is always empty when you run the procedure.... do you not need the increment in the case else part of the statement? Otherwise you're back to your original problem, I think

 

[hgus393]

That'd work... if 'buckets' is always empty when you run the procedure.... do you not need the increment in the case else part of the statement? Otherwise you're back to your original problem, I think

Yes this is run daily so yeah the buckets will always be emptied before running the proc. Since buckets is empty it will fill in the nearest 65 working days.

Cheers

Rob