Appointments, Perpetual Calender

[Ra]

Please can you help me with the following problem:

I pick up appointment dates from a worksheet. I want the macro to look at
the appointment date and then modify the appointment date so it starts on the
Monday preceding the appointment date, ie, week commencing. However, some of
these dates may also fall on either Saturday or Sunday which are no good, so
these need to be excluded. Any dates falling on Saturday or Sunday would
still need to start on the preceding Monday. In addition, I would like this
to work on a perpetual calender basis, starting from 2009 onwards.

I have attached the Macro below which I am currently using to pick up the
appointments from the worksheet and generate a letter which is then printed
automatically. I would like the modification to form part of the macro below.

Please can you help.
________________________________________________________________
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target
As Range, Cancel As Boolean)
Sheets(1).Activate
If ActiveCell.Column = 12 And ActiveCell.Interior.ColorIndex = 4 Then
Call Vac2
End If
End Sub
_________________________________________________________________

Sub Vac2()
Sheets("Sheet2").Range("A" & 11) = "Dear " & Sheets("Sheet1").Range("AZ" &
ActiveCell.Row)
Sheets("Sheet2").Range("A" & 13) = "Re: " & Sheets("Sheet1").Range("A" &
ActiveCell.Row)
Sheets("Sheet2").Range("A" & 15) = "Address: " & Sheets("Sheet1").Range("B"
& ActiveCell.Row)
Sheets("Sheet2").Range("A" & 18) = "DB: " & Sheets("Sheet1").Range("F" &
ActiveCell.Row)
Sheets("Sheet2").Range("A" & 20) = "FR: " & Sheets("Sheet1").Range("D" &
ActiveCell.Row)
Sheets("Sheet2").Range("A" & 26) = "Appointment 1, week commencing: " &
Sheets("Sheet1").Range("J" & ActiveCell.Row)
Sheets("Sheet2").Range("A" & 28) = "Appointment 2, week commencing: " &
Sheets("Sheet1").Range("O" & ActiveCell.Row)
Sheets("Sheet2").Range("A" & 30) = "Appointment 3, week commencing: " &
Sheets("Sheet1").Range("T" & ActiveCell.Row)
Sheets("Sheet2").Range("A" & 33) = "Appointment 4 is required week
commencing: " & Sheets("Sheet1").Range("Y" & ActiveCell.Row)
Sheets(2).Activate
Range("A150").Select
ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,1,,,TRUE,,FALSE)"
End Sub

 

[Shane Devenshire]

Hi,

In the spreadsheet the general formula for doing this is

=A1-MOD(A1-2,7)
or
=A1-WEEKDAY(A1,3)

You can modify either of these to work in code. These assume the
appointment date is in A1.

 

[Ra]

Shane

You are a Star. Thank you for your help.

Hi,

In the spreadsheet the general formula for doing this is

=A1-MOD(A1-2,7)
or
=A1-WEEKDAY(A1,3)

You can modify either of these to work in code. These assume the
appointment date is in A1.

--
If this helps, please click the Yes button.

Cheers,
Shane Devenshire