compcobalt
compcobalt

Reputation: 1362

Get Current Monday?

I have this string that is a date called strRDate and another string called strColor. The cutoff date is this weeks Monday.

I would like to be something like this:

'// strRDate format is MM/DD/YYYY

Dim strRDate,strColor
strRDate="1/1/1999"
strColor="none"   

 If strRDate is this weeks Monday or older then  <-- HOW DO I DO THIS ???
    strColor="green"
    else 
    strColor="red"
    end if

So anything older then Oct 21, 2013 would be green, else it would be red.

Upvotes: 0

Views: 110

Answers (3)

Ansgar Wiechers
Ansgar Wiechers

Reputation: 200233

I'd probably do the calculation like this:

strRDate = "1/1/1999"
strColor = "none"

monday = Date - (Weekday(Date, vbMonday) - 1)

If CDate(strRDate) <= monday Then
  strColor="green"
Else 
  strColor="red"
End If

Weekday(Date, vbMonday) returns a value between 1 and 7 for each day of the week, with Monday being the first day:

Monday    → 1
Tuesday   → 2
Wednesday → 3
Thursday  → 4
Friday    → 5
Saturday  → 6
Sunday    → 7

Subtract 1 from the return value of the function and you get the difference in days between the current date and the most recent Monday. Subtracting that difference from the current date gives you the date of the most recent Monday, which you can then compare to your input date (use the CDate function to convert the string to an actual date).

Upvotes: 1

Ekkehard.Horner
Ekkehard.Horner

Reputation: 38745

This date's monday can be calculated by substracting the Weekday() and adjusting for the Weekday of mondays:

  WScript.Echo "german locate (dd.mm.yyyy):"
  Dim dtCur : dtCur = #10/10/2013#
  Do Until dtCur > #10/24/2013#
     Dim dtThisMonday      : dtThisMonday      = DateAdd("d", -WeekDay(dtCur) + 2, dtCur)
     Dim isAfterThisMonday : isAfterThisMonday = dtCur > dtThisMonday
     WScript.Echo dtCur, WeekDay(dtCur), WeekdayName(WeekDay(dtCur), True), dtThisMonday, CStr(isAfterThisMonday)
     dtCur = DateAdd("d", 1, dtCur)
  Loop

output:

german locate (dd.mm.yyyy):
10.10.2013 5 Thu 07.10.2013 True
11.10.2013 6 Fri 07.10.2013 True
12.10.2013 7 Sat 07.10.2013 True
13.10.2013 1 Sun 14.10.2013 False
14.10.2013 2 Mon 14.10.2013 False
15.10.2013 3 Tue 14.10.2013 True
16.10.2013 4 Wed 14.10.2013 True
17.10.2013 5 Thu 14.10.2013 True
18.10.2013 6 Fri 14.10.2013 True
19.10.2013 7 Sat 14.10.2013 True
20.10.2013 1 Sun 21.10.2013 False
21.10.2013 2 Mon 21.10.2013 False
22.10.2013 3 Tue 21.10.2013 True
23.10.2013 4 Wed 21.10.2013 True
24.10.2013 5 Thu 21.10.2013 True

Upvotes: 0

Tomalak
Tomalak

Reputation: 338158

' for successful parsing of mm/dd/yyyy dates (1033 is EN_US)
Response.LCID = 1033

Dim strRDate, strColor

strRDate = "10/21/2013"
strColor = GetColor(ParseDate(strRDate))

and a few helper functions:

Function GetColor(d) 
    GetColor = "none"

    If IsDate(d) Then
        If d <= GetMondayForWeek(Now()) Then
            GetColor = "green"
        Else
            GetColor = "red"
        End If
    End If
End Function

Function ParseDate(strDate)
    ParseDate = vbEmpty
    If IsDate(strDate) Then
        ParseDate = CDate(strDate)
    End If
End Function

Function GetMondayForWeek(d)
    ' midnight
    GetMondayForWeek = CDate(Fix(d))

    While Weekday(GetMondayForWeek) <> vbMonday
      GetMondayForWeek = GetMondayForWeek - 1 
    Wend
End Function

Upvotes: 2

Related Questions