Solved: Tricky Yearly Number Converter

[nickirvine]

Hello Everyone,

Looking for any help or pointers in a tricky macro im trying to set up. Its a little complicated so please stick with me!

I want to be able to enter a date in to a form in word (something like 01/08/2008) i then want to also enter a weekday (mon-fri) I want a macro to add 52 weeks onto the date added, find the weekday before and calculate the number of days different.

i.e enter 01/08/2008 & friday

The macro does it magic and produces (im making these results up as dont have a calender!)

29/07/2009 (the date 52 weeks on), 3 days different (difference between 52 weeks on and the weekday entered)

Something like that. I need these results as variables in the code which I can then fiddle around with.

Hope that makes sense. Can anyone offer me any pointers or give me some starting point as I'm lost as to how i can achieve this or where to start.

I'm guessing you need to convert the date you enter into a number, the number of that day in the year (i.e 01/01/09 - would be 1, 02/01/09, would be 2 etc. (ive seen this done somewhere im sure!)

Then add on 364 (52 weeks in days) so.. using 01/01/09 as an example would become 365.

then convert this number back to a date, then somehow work backwards and find the day (the weekday entered in the form) before the day numbered 365.

then on getting this number take it away from 365 to find the difference.

Im sure this method is possible. I'm used to using PHP code and thats way I would do it with that but with VB im very much a newbie. Any help will be greatly appreciated.

Thanks for your time in reading my long winded post!

[Paul_Hossler]

This will get you started


Option Explicit

Sub Demo()
Dim sDate As String, sDOW As String
Dim dDate As Date
Dim iDOW As Long, iDOW2 As Long
'form field might be a string, if not delete
sDate = "01/08/2008" ' BTW, this is a Tuesday = 3
sDOW = "tue"
'convert string to date
dDate = DateValue(sDate)

'add 52 weeks
dDate = DateAdd("ww", 52, dDate)
iDOW = Weekday(dDate)
Select Case Left(UCase(sDOW), 2)
Case "SU": iDOW2 = 1
Case "MO": iDOW2 = 2
Case "TU": iDOW2 = 3
Case "WE": iDOW2 = 4
Case "TH": iDOW2 = 5
Case "FR": iDOW2 = 6
Case "Sa": iDOW2 = 7
Case Else
MsgBox "Bad DOW requested"
End Select
'this will always back up, including 7 days
'if the destimation DOW = start DOW
dDate = dDate - (7 - iDOW2 + iDOW)
'this will leave it on the 52 week mark
' If iDOW <> iDOW2 Then dDate = dDate - (7 - iDOW2 + iDOW)
MsgBox "52 weeks from " & sDate & " is " & _
Format(dDate, "yyyy-mm-dd") _
& " which is DOW = " & Weekday(dDate)
End Sub



Paul

[macropod]

How about:
Sub Demo()
Dim sDate As String, dDate1 As Date, dDate2 As Date, sDay As String
sDate = InputBox("Please input a Date", , Format(Now, "dd-mmm-yyyy"))
If IsDate(sDate) Then
dDate1 = CDate(sDate)
Else
MsgBox "Bad Date input", vbExclamation
End
End If
dDate2 = dDate1 + 364
sDay = UCase(Left(InputBox("Please input a Weekday"), 2))
Select Case sDay
Case "SU": sDay = "Sunday"
Case "MO": sDay = "Monday"
Case "TU": sDay = "Tuesday"
Case "WE": sDay = "Wednesday"
Case "TH": sDay = "Thursday"
Case "FR": sDay = "Friday"
Case "SA": sDay = "Saturday"
Case Else
MsgBox "Bad Day input", vbExclamation
End
End Select
While Format(dDate2, "dddd") <> sDay
dDate2 = dDate2 - 1
Wend
MsgBox "The first " & sDay & " on or before 52 weeks" & vbCr _
& "from: " & Format(dDate1, "dddd, dd-mmm-yyyy") & vbCr & _
"is: " & Format(dDate2, "dddd, dd-mmm-yyyy")
End Sub

[nickirvine]

Thanks loads for your starting point. Got it to do exactly what I wanted.

Thanks again.

[nickirvine]

Hi,

I have one more query if possible. I am using this code to display the message box:

sday & " Day Selected : Amount: " & amount & vbCr _
& "Day Entered: " & Format(dDate1, "dddd, dd-mmm-yyyy") & vbCr & _
"52 weeks on: " & Format(dDate4, "dddd, dd-mmm-yyyy") & vbCr & _
"Last Week Start: " & Format(dDate3, "dddd, dd-mmm-yyyy") & " To " & Format(dDate2, "dddd, dd-mmm-yyyy") & vbCr & _
"Difference: " & difference & " day(s)" & vbCr & _
"Difference in amount " & differenceamount

I want to be able to print this message box or transpose it on the document and print. I am currently running a macro on the page that copies data entered into a form onto bookmarks in the page. I'm using this to do that:

Private Sub wb(bname, ByVal inhalt As String)

Dim r As Range
Set r = ActiveDocument.Bookmarks(bname).Range
r.Text = inhalt
ActiveDocument.Bookmarks.Add bname, r

End Sub

Then for every bookmark im using:

Private Sub Address_Change()
wb "Address", Address
End Sub

Could I adapt my results to use this system to put the data entered in macropod's code onto a document? any help appreciated. Thanks

[macropod]

Hi Nick,

You could use something along the lines of:
Dim BkTxt as String
BkTxt = sday & " Day Selected : Amount: " & amount & vbCr _
& "Day Entered: " & Format(dDate1, "dddd, dd-mmm-yyyy") & vbCr & _
"52 weeks on: " & Format(dDate4, "dddd, dd-mmm-yyyy") & vbCr & _
"Last Week Start: " & Format(dDate3, "dddd, dd-mmm-yyyy") & _
" To " & Format(dDate2, "dddd, dd-mmm-yyyy") & vbCr & _
"Difference: " & difference & " day(s)" & vbCr & _
"Difference in amount " & differenceamount
Call wb "BkNm", BkTxt
where 'BkNm' is the name of the bookmark into which you want the output inserted.

If you need the same infor at multiple locations, simply use cross-references in the document to your 'BkNm', instead of multiple bookmarks. You can then update the lot with:
ActiveDocument.Fields.Update

Note: If there's a need for the output to appear in the header or footer, put the bookmark there and have all the cross-references in the body of the document.