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