# Calculating 3rd Thursday in every month of the year in VBA module

I am trying to calculate the date of every 3rd Thursday of the month for given the year.  I have seen some code for calculating, say the 4th Thursday in VB on this site but have not seen anything in Access VBA.  I am hoping an expert could help me out on my app.
###### Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Commented:
The code below will calculate the first Tuesday of the month, just add 14 to get the third.
Cheers, Andrew
``````Function FirstTuesday(pdtmDate As Date) As Date
Dim dtmFirstOfMonth As Date

dtmFirstOfMonth = DateSerial(Year(pdtmDate), Month(pdtmDate), 1)
Select Case Weekday(dtmFirstOfMonth)
Case vbTuesday: FirstTuesday = dtmFirstOfMonth
Case vbWednesday: FirstTuesday = dtmFirstOfMonth + 6
Case vbThursday: FirstTuesday = dtmFirstOfMonth + 5
Case vbFriday: FirstTuesday = dtmFirstOfMonth + 4
Case vbSaturday: FirstTuesday = dtmFirstOfMonth + 3
Case vbSunday: FirstTuesday = dtmFirstOfMonth + 2
Case vbMonday: FirstTuesday = dtmFirstOfMonth + 1
End Select
End Function
``````
0
Author Commented:
I'm a little confused.  What would the case statement look like for the 4th thursday of the month?
0
Commented:
Sorry I got it into my head it was tuesdays not Thursdays. The function will return the first Thursday so for the 4th add 21

FourthThursday: FirstThursday(pdtmDate As Date) + 21

Cheers, Andrew
``````Function FirstThursday(pdtmDate As Date) As Date
Dim dtmFirstOfMonth As Date

dtmFirstOfMonth = DateSerial(Year(pdtmDate), Month(pdtmDate), 1)
Select Case Weekday(dtmFirstOfMonth)
Case vbThursday: FirstThursday = dtmFirstOfMonth
Case vbFriday: FirstThursday = dtmFirstOfMonth + 6
Case vbSaturday: FirstThursday = dtmFirstOfMonth + 5
Case vbSunday: FirstThursday = dtmFirstOfMonth + 4
Case vbMonday: FirstThursday = dtmFirstOfMonth + 3
Case vbTuesday: FirstThursday = dtmFirstOfMonth + 2
Case vbWednesday: FirstThursday = dtmFirstOfMonth + 1
End Select
End Function
``````
0

Experts Exchange Solution brought to you by