Double Friday The 14th

[Klatuu]

This is an unusual Friday the 13th in that all the digits in the date add up
to 13
1+1+3+2+6 = 13

The last time that happened was January 13, 1520
1+1+3+1+5+2

What to know when it will happen again?

Here is a function that will calculate it:

Public Function WhenIs13() As Date
Dim dtmStart As Date
Dim strDate As String
Dim lngCtr As Long
Dim lngTot As Long

dtmStart = #11/13/2006#
Do While True
dtmStart = DateAdd("m", 1, dtmStart)
Do Until Weekday(dtmStart) = 6
dtmStart = DateAdd("m", 1, dtmStart)
Loop
strDate = Format(dtmStart, "yyyymmdd")
strDate = Replace(strDate, "0", "")
lngTot = 0
For lngCtr = 1 To Len(strDate)
lngTot = lngTot + CLng(Mid(strDate, lngCtr, 1))
Next lngCtr
If lngTot = 13 Then
WhenIs13 = dtmStart
Exit Do
End If
Loop

End Function

 

[Fred Boer]

Ok..... step away from the computer.....time to take a little break...

Cheers!
Fred Boer

P.S. Of course, now I have to try to figure out how it works... there goes
my productivity for the afteroon!!

 

[Klatuu]

That was my break. I am writing documentation for users who will never read
it.

 

[Klatuu]

'Start with the next 13th of the month
dtmStart = #10/13/2006# 'This is what it should have been
Do While True
'Add a month so we are on the 13th of the next month
dtmStart = DateAdd("m", 1, dtmStart)
'See if it is a Friday
Do Until Weekday(dtmStart) = 6
dtmStart = DateAdd("m", 1, dtmStart)
Loop
'Make a string of all the digits
strDate = Format(dtmStart, "yyyymmdd")
'Take out the zeros
strDate = Replace(strDate, "0", "")
'Initialize the varialbe to sum the digits
lngTot = 0
'Add each digit in the strin to the sum
For lngCtr = 1 To Len(strDate)
lngTot = lngTot + CLng(Mid(strDate, lngCtr, 1))
Next lngCtr
'If it adds up to 13, we have what we are looking for
If lngTot = 13 Then
WhenIs13 = dtmStart
Exit Do
End If
'That was not it - keep looking
Loop

NOW BACK TO WORK FRED!

 

[Fred Boer]

Dear Klatuu:

Ah, I see! <Chuckle>

This summer I was struggling through the documentation for an API. Buried
deep in the middle of it all was the sentence: "I think brachiosaurs were
the most interesting dinosaurs. If you agree, email me at...".

I emailed and got a cheerful response from the author, even though I had to
tell him I prefer triceratops!

Fred

 

[Fred Boer]

Oh, ok, if I HAVE to!

Fred

'Start with the next 13th of the month
dtmStart = #10/13/2006# 'This is what it should have been
Do While True
'Add a month so we are on the 13th of the next month
dtmStart = DateAdd("m", 1, dtmStart)
'See if it is a Friday
Do Until Weekday(dtmStart) = 6
dtmStart = DateAdd("m", 1, dtmStart)
Loop
'Make a string of all the digits
strDate = Format(dtmStart, "yyyymmdd")
'Take out the zeros
strDate = Replace(strDate, "0", "")
'Initialize the varialbe to sum the digits
lngTot = 0
'Add each digit in the strin to the sum
For lngCtr = 1 To Len(strDate)
lngTot = lngTot + CLng(Mid(strDate, lngCtr, 1))
Next lngCtr
'If it adds up to 13, we have what we are looking for
If lngTot = 13 Then
WhenIs13 = dtmStart
Exit Do
End If
'That was not it - keep looking
Loop

NOW BACK TO WORK FRED!

 

[Marshall Barton]

Can anyone join in this circus?

I couldn't resist trying some different code to find all
these weird fridays in the next five centuries:

The13th 2006,2506

Sub The13th(StartYear As Integer, EndYear As Integer)
Dim m As Integer, dt As Date

For m = 1 To 12 * (EndYear - StartYear + 1)
dt = DateSerial(StartYear, m, 13)
If Eval(Format(Format(dt, "mmddyyyy"), _
"@+@+@+@+@+@+@+@")) = 13 _
And DatePart("w", dt) = 6 _
Then Debug.Print dt
Next m
End Sub

Bed time!