Finding Almost This Friday

I have a utility that determines the date of the upcoming Friday. It used to look like this

dtReturn = Date + 8 - Weekday(Date, vbFriday)

It has served me well for many years. Until this year. This year, the US celebrated Veterans Day on November 11. While I’m work, the bankers are all at home rolling around in their money. Since my bank would not process any ACH transactions that day, I paid my employees the preceding Thursday. But my function didn’t say “return this Friday unless it happens to be a banking holiday” but now it does.

Public Function ThisFriday() As Date

Dim dtReturn As Date
Dim i As Long

'if i'm testing, hardcode the date
If Len(Dir(gsDEBUGDATE)) > 0 Then
Stop
dtReturn = #2/18/2011#
Else
'return the next friday
dtReturn = Date + 8 - Weekday(Date, vbFriday)

'if there are no checks on that date, look for
'a nearby date with checks
If Not gclsEmployees Is Nothing Then
If Not gclsEmployees.HasChecks(dtReturn) Then
For i = 1 To 7
If gclsEmployees.HasChecks(dtReturn + i) Then
dtReturn = dtReturn + i
Exit For
ElseIf gclsEmployees.HasChecks(dtReturn - i) Then
dtReturn = dtReturn - i
Exit For
End If
Next i
End If
End If
End If

ThisFriday = dtReturn

End Function

And the HasChecks property is just a loop

Public Property Get HasChecks(dtCheck As Date) As Boolean

Dim bReturn As Boolean
Dim clsEmployee As CEmployee

bReturn = False

For Each clsEmployee In Me
If Not clsEmployee.CheckByDate(dtCheck) Is Nothing Then
bReturn = True
Exit For
End If
Next clsEmployee

HasChecks = bReturn

End Property

Man I hate when real life gets in the way of good code. I need to get rid of that arrow antipattern, but otherwise I’d say this is solved for all time. Jinx.

Posted in VBA

One thought on “Finding Almost This Friday

  1. It’s quite easy to remove code arrows (nested IFs without code in the Else clauses). I’ve shared the below before and it’s obviously worth repeating.

    Just reverse the test for each If and use ElseIf to remove the nested IFs

    If gclsEmployees Is Nothing Then
    ElseIf gclsEmployees.HasChecks(dtReturn) Then
    Else
    For I = 1 To 7
    If gclsEmployees.HasChecks(dtReturn + I) Then
    dtReturn = dtReturn + I
    Exit For
    ElseIf gclsEmployees.HasChecks(dtReturn - I) Then
    dtReturn = dtReturn - I
    Exit For
    End If
    Next I
    End If

    Another item worth noting is the use of 'Exit For'. IMO, it's worse than a GoTo because it's nothing other than a goto with an implicit label. This requires the reader to hunt for and decode the target of the goto. :(

    I prefer the more explicit Do...Loop structure.


    If gclsEmployees Is Nothing Then
    ElseIf gclsEmployees.HasChecks(dtReturn) Then
    Else
    Dim MatchFound As Boolean
    Dim I As Byte: I = 1
    Do
    If gclsEmployees.HasChecks(dtReturn + I) Then
    MatchFound = True: dtReturn = dtReturn + I
    ElseIf gclsEmployees.HasChecks(dtReturn - I) Then
    MatchFound = True: dtReturn = dtReturn - I
    End If
    I = I + 1
    Loop Until MatchFound Or I > 7
    End If


Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.