# 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. Tushar Mehta says:

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.