Dim todaydt As String		' today's date as string
Dim dayofwk As Integer		' day of week, 1-7, where 1=Sunday (first day)
Dim dayofmo As Integer		' day of month, 1-31
Dim weekno As Integer		' week of the month

todaydt = Today()
dayofwk = weekday(todaydt)
dayofmo = Day(todaydt)

weekno = MonthWeek(dayofmo, dayofwk)




Function MonthWeek(dayofmo As Integer, dayofwk As Integer) As Integer
	' with current day of the month and day of the week,
	' what week is this?
	
	If (dayofmo < (7 + dayofwk)) Then
		' this is first week
		MonthWeek = 1
		Exit Function
	End If
	If (dayofmo < (14 + dayofwk)) Then
		' this is second week
		MonthWeek = 2
		Exit Function
	End If
	If (dayofmo < (21 + dayofwk)) Then
		' this is third week
		MonthWeek = 3
		Exit Function
	End If
	If (dayofmo < (28 + dayofwk)) Then
		' this is fourth week
		MonthWeek = 4
		Exit Function
	End If
	
	' if greater than this, must be a partial 5th week
	If (dayofmo > (27 + dayofwk) Then
		' this is fifth week
		MonthWeek = 5
		Exit Function
	End If

	' if still here then bad dada may have been passed
	' return 0 for error
	MonthWeek = 0
Exit Function