• Outlook User
  • New Outlook app
  • Outlook.com
  • Outlook Mac
  • Outlook & iCloud
  • Developer
  • Microsoft 365 Admin
    • Common Problems
    • Microsoft 365
    • Outlook BCM
    • Utilities & Addins

Create Outlook appointments using multiple recurring patterns

Slipstick Systems

› Developer › Create Outlook appointments using multiple recurring patterns

Last reviewed on May 28, 2013     52 Comments

Outlook's recurring patterns leave a lot to be desired. The available recurring patterns are limited and support just one pattern per event: every other Thursday, every third Thursday etc, not the first and third Thursday or second Monday after the first Wednesday.

While it's often better to create 2 recurring appointments for patterns such as first and third Thursdays (one for the first event each month and one for the second), you can use VBA to create individual events in more flexible patterns such as the third Tuesday after the first Thursday.

This code takes the subject, start time, location, and duration from the selected or open appointment and creates a series of individual appointments for the first Monday and a second one xx days later in each month for xx months.

To use a different day of the week or a different week, adjust the pdtdate in the macro. (Or, edit the function.)

The next Friday is pdtmdate = Format(pdtmdate + 4, "MM/dd/yyyy")
Third Monday is pdtmdate = Format(pdtmdate + 14, "MM/dd/yyyy")

The date for the second appointment is calculated off of the first appointment:
objAppt3.Start = objAppt2.Start + 14

If you only need one appointment per month, delete the block of code used to create the second appointment.

Raymond wrote a more complex macro to set multiple appointments and checks for holidays too. His version of the macro is here.


Public Sub CreatePatternsAppointmentSeries()
  Dim objAppt As Outlook.AppointmentItem
  Dim objAppt2 As Outlook.AppointmentItem
  Dim objAppt3 As Outlook.AppointmentItem
  Dim NumOfDays As Long
  Dim Offset As Long
  Dim NumAppt As Long
  Dim nextAppt 'As Date
   
 Set objAppt = GetCurrentItem()
 If TypeName(objAppt) = "AppointmentItem" Then
 
 
pdtmdate = InputBox("Enter beginning month and year in mm/yyyy format", _
      "First month of series", Format(Now, "mm/yyyy"))
      
NumAppt = InputBox("How many months in the series? (2 appointments per month)")
Offset = InputBox("How days is the second appointment offset from the first?")

'change this line for other dates
pdtmdate = FirstMondayofMonth(Format(pdtmdate, "MM/dd/yyyy"))
 
For x = 1 To NumAppt
Set objAppt2 = Application.CreateItem(olAppointmentItem)
      
 ' calculate other dates in this line, "pdtmdate +14,"
      pdtmdate = Format(pdtmdate, "MM/dd/yyyy")

With objAppt
' I'm using a limited number of fields, you can
' add others.
        objAppt2.Subject = .Subject
        objAppt2.Location = .Location
        objAppt2.Body = .Body
        objAppt2.Start = Format(pdtmdate, "MM/dd/yyyy") & _
           " " & Format(objAppt.Start, "hh:mm AMPM")
        objAppt2.Duration = .Duration
        objAppt2.Categories = .Categories
      End With
      On Error Resume Next
      objAppt2.Save
       
       
' create the second appointment
 Set objAppt3 = Application.CreateItem(olAppointmentItem)
      With objAppt
        objAppt3.Subject = .Subject
        objAppt3.Location = .Location
        objAppt3.Body = .Body
        objAppt3.Start = objAppt2.Start + Offset
        objAppt3.Duration = .Duration
        objAppt3.Categories = .Categories
      End With
      On Error Resume Next
      objAppt3.Save
    
      
     ' Get the next month before looping back through   
If Format(pdtmdate, "mm") < 12 Then
    pdtmdate = Format(pdtmdate, "mm") + 1 & "/" & Format(pdtmdate, "yyyy")
Else
   pdtmdate = Format("1/1/2009", "mm") & "/" & (Format(pdtmdate, "yyyy") + 1)
End If

pdtmdate = FirstMondayofMonth(Format(pdtmdate, "MM/dd/yyyy"))

Next x
 
End If
   
    Set objAppt = Nothing
    Set objAppt2 = Nothing
    Set objAppt3 = Nothing
     

End Sub

Function FirstMondayofMonth(pdtmdate As Date) As Date
Dim dtmFirstOfMonth As Date
 
    dtmFirstOfMonth = DateSerial(Year(pdtmdate), Month(pdtmdate), 1)
    Select Case Weekday(dtmFirstOfMonth)
         Case vbMonday: FirstMondayofMonth = dtmFirstOfMonth
         Case vbTuesday: FirstMondayofMonth = dtmFirstOfMonth + 6
         Case vbWednesday: FirstMondayofMonth = dtmFirstOfMonth + 5
         Case vbThursday: FirstMondayofMonth = dtmFirstOfMonth + 4
         Case vbFriday: FirstMondayofMonth = dtmFirstOfMonth + 3
         Case vbSaturday: FirstMondayofMonth = dtmFirstOfMonth + 2
         Case vbSunday: FirstMondayofMonth = dtmFirstOfMonth + 1
         
    End Select
End Function

Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application
            
    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select
        
    Set objApp = Nothing
End Function

Count back from the end of the month

To get the last day of the month we use the code above, replacing the FirstMondayofMonth function to count from the end of the month instead.

You'll also need to subtract from the date line:
pdtmdate = LastDayofMonth(Format(pdtmdate - 4, "MM/dd/yyyy"))

To use this function with the code above, change FirstMondayofMonth to LastMondayofMonth in this line (it's used twice).

pdtmdate = FirstMondayofMonth(Format(pdtmdate, "MM/dd/yyyy"))

Function LastMondayofMonth(pdtmdate As Date) As Date
 Dim dtmLastOfMonth As Date
 
    dtmLastOfMonth = DateSerial(Year(pdtmdate), Month(pdtmdate) + 1, 0)
    Select Case Weekday(dtmLastOfMonth)
         Case vbMonday: LastMondayofMonth = dtmLastOfMonth
         Case vbTuesday: LastMondayofMonth = dtmLastOfMonth - 1
         Case vbWednesday: LastMondayofMonth = dtmLastOfMonth - 2
         Case vbThursday: LastMondayofMonth = dtmLastOfMonth - 3
         Case vbFriday: LastMondayofMonth = dtmLastOfMonth - 4
         Case vbSaturday: LastMondayofMonth = dtmLastOfMonth - 5
         Case vbSunday: LastMondayofMonth = dtmLastOfMonth - 6
    End Select
End Function

Create Outlook appointments using multiple recurring patterns was last modified: May 28th, 2013 by Diane Poremsky

Related Posts:

  • One (very justified) complaint about Outlook recurrence patterns is th
    Create Outlook appointments for every nn workday
  • Copy Recurring Appointment Series to Appointments
  • Create a Series of Tasks Leading up to an Appointment
  • How to print a list of recurring dates using VBA

About Diane Poremsky

A Microsoft Outlook Most Valuable Professional (MVP) since 1999, Diane is the author of several books, including Outlook 2013 Absolute Beginners Book. She also created video training CDs and online training classes for Microsoft Outlook. You can find her helping people online in Outlook Forums as well as in the Microsoft Answers and TechNet forums.

Subscribe
Notify of
52 Comments
newest
oldest most voted
Inline Feedbacks
View all comments

Carlo M Merhi
February 19, 2019 5:07 pm

I would be forever in your debt if you can figure out how to make this pattern happen. I got close but not on the Grey and Black and not without having 3 different VBAs, one for each set.

Yellow - 2nd Tuesday of the month
Blue - 1st Friday after Yellow

Orange - 3rd Tuesday of the month
Red - 1st Wed after Orange

Grey - 1st Tuesday of the month
Black - 1st Friday before Grey

If any of the dates (except Yellow) falls on a Holiday, pick the day before if it is a weekday else the first day after holiday if it is a weekday.

0
0
Reply
Pete Motley
April 8, 2018 10:09 pm

Or, create appointments in new Google calendar, export to ics file and import into Outlook

1
0
Reply
Diane Poremsky
Author
Reply to  Pete Motley
April 8, 2018 11:53 pm

to make a weird recurring pattern?

0
0
Reply
Darren
February 1, 2018 12:22 pm

Would it be possible to create a recurring calendar event that excludes ever other Wednesday, after the creation of the event?

0
0
Reply
Diane Poremsky
Author
Reply to  Darren
February 9, 2018 10:36 pm

to make a truly recurring event, you'd need to set exceptions. The macro on this page creates individual events - it could create the pattern you want if you calculate the pattern correctly.

0
0
Reply
jarvis
June 6, 2016 12:45 pm

Hello. Thanks for the code.

Is there a way to get the appts to use the reoccurrence feature so they can be edited at one time?

For example, if I use your script to creatre my appts they look to be separate. So if I want to update my invitee list, or the subject I will have to do it for each individual appt. Any way to do this through one edite rather than multiple edits?

Thank you.

0
0
Reply
Diane Poremsky
Author
Reply to  jarvis
June 6, 2016 1:35 pm

you can use a script to create recurring appointments that are in one of outlook's patterns, it could do the exceptions too, but too many exceptions tend to corrupt it. Individual events (what this script does) are definitely better for appointments but more annoying for meetings. I don't think i have any example code that creates recurring with exceptions, but will check.

1
0
Reply
ritzymitzy
July 13, 2015 2:39 pm

Sweet! Macro totally works. Thanks so much, Diane!

0
0
Reply
victor abraham
May 6, 2015 1:31 pm

Hello to all. I a physician with no programming experience. I am charged of creating the call schedule for the urologists in my town , using outlook calendar. We define the working week as all day long Monday through Thursday and the weekend call schedule as Friday, Sat and Sunday till 7 am Monday. Creating the weekend recurrent call schedule is easy. The weekdays, as every 9 weekdays is only possible creating a round of 9 days and then cutting and pasting.
Has anyone encountered this issue? and more importantly a solution to it
Thanks in advance!
Victor

0
0
Reply
Diane Poremsky
Author
Reply to  victor abraham
May 10, 2015 9:22 am

Everyone encounters it, unfortunately, there is no easy solution. Copy, paste, and change the date should work... it might be a little easier although the same amount of work. Create the first, copy it, move the copy to the date it belongs on then edit as needed.

0
0
Reply
Chris
January 15, 2015 11:55 am

This is great! I'm having an issue with the number of months though. I've set 13 appointments for January based around the LastMondayofMonth code, which all work perfectly. However, if I attempt to run the code for more than 1 month I simply get 2 January appointments? I've checked my code to see if I've input an actual date somewhere by mistake but I haven't.

0
0
Reply
Diane Poremsky
Author
Reply to  Chris
February 8, 2015 1:03 am

It's been a few years since I last tried it so my memory is fuzzy, but I seem to recall it was a bit goofy, so my guess is that the problem is with the code, not you.

0
0
Reply
Adrie Rijnen
January 6, 2015 2:38 am

If you want to get any day use

DateFirstOfMonth = DateSerial(Year(InDate), Month(InDate), 1)
DaysAfterFirstOfMonth = InDay - Weekday(DateFirstOfMonth)
If DaysAfterFirstOfMonth >= 7 Then DaysAfterFirstOfMonth = DaysAfterFirstOfMonth - 7
If DaysAfterFirstOfMonth < 0 Then DaysAfterFirstOfMonth = DaysAfterFirstOfMonth + 7

for InDay I use vbMonday,vbTuesday etc. You can even use a form to let the user select the day and transform it into a long

0
0
Reply

Visit Slipstick Forums.
What's New at Slipstick.com

Latest EMO: Vol. 30 Issue 36

Subscribe to Exchange Messaging Outlook






Support Services

Do you need help setting up Outlook, moving your email to a new computer, migrating or configuring Office 365, or just need some one-on-one assistance?

Our Sponsors

CompanionLink
ReliefJet
  • Popular
  • Latest
  • Week Month All
  • Use Classic Outlook, not New Outlook
  • How to Remove the Primary Account from Outlook
  • How to Hide or Delete Outlook's Default Folders
  • Removing Suggested Accounts in New Outlook
  • Reset the New Outlook Profile
  • This operation has been cancelled due to restrictions
  • iCloud error: Outlook isn't configured to have a default profile
  • Adjusting Outlook's Zoom Setting in Email
  • Online Services in Outlook: Gmail, Yahoo, iCloud, AOL, GoDaddy
  • Add Holidays to Outlook's Calendar
  • Opt out of Microsoft 365 Companion Apps
  • Mail Templates in Outlook for Windows (and Web)
  • Urban legend: Microsoft Deletes Old Outlook.com Messages
  • Buttons in the New Message Notifications
  • Move Deleted Items to Another Folder Automatically
  • Open Outlook Templates using PowerShell
  • Count and List Folders in Classic Outlook
  • Google Workspace and Outlook with POP Mail
  • Import EML Files into New Outlook
  • Opening PST files in New Outlook
Ajax spinner

Recent Bugs List

Microsoft keeps a running list of issues affecting recently released updates at Fixes or workarounds for recent issues in classic Outlook (Windows).

For new Outlook for Windows: Fixes or workarounds for recent issues in new Outlook for Windows .

Outlook for Mac Recent issues: Fixes or workarounds for recent issues in Outlook for Mac

Outlook.com Recent issues: Fixes or workarounds for recent issues on Outlook.com

Office Update History

Update history for supported Office versions is at Update history for Office

Outlook Suggestions and Feedback

Outlook Feedback covers Outlook as an email client, including Outlook Android, iOS, Mac, and Windows clients, as well as the browser extension (PWA) and Outlook on the web.

Outlook (new) Feedback. Use this for feedback and suggestions for Outlook (new).

Use Outlook.com Feedback for suggestions or feedback about Outlook.com accounts.

Other Microsoft 365 applications and services




New Outlook Articles

Opt out of Microsoft 365 Companion Apps

Mail Templates in Outlook for Windows (and Web)

Urban legend: Microsoft Deletes Old Outlook.com Messages

Buttons in the New Message Notifications

Move Deleted Items to Another Folder Automatically

Open Outlook Templates using PowerShell

Count and List Folders in Classic Outlook

Google Workspace and Outlook with POP Mail

Import EML Files into New Outlook

Opening PST files in New Outlook

Newest Code Samples

Open Outlook Templates using PowerShell

Count and List Folders in Classic Outlook

Insert Word Document into Email using VBA

Warn Before Deleting a Contact

Use PowerShell to Delete Attachments

Remove RE:, FWD:, and Other Prefixes from Subject Line

Change the Mailing Address Using PowerShell

Categorize @Mentioned Messages

Send an Email When You Open Outlook

Delete Old Calendar Events using VBA

VBA Basics

How to use the VBA Editor

Work with open item or selected item

Working with All Items in a Folder or Selected Items

VBA and non-default Outlook Folders

Backup and save your Outlook VBA macros

Get text using Left, Right, Mid, Len, InStr

Using Arrays in Outlook macros

Use RegEx to extract message text

Paste clipboard contents

Windows Folder Picker

Custom Forms

Designing Microsoft Outlook Forms

Set a custom form as default

Developer Resources

Developer Resources

Developer Tools

VBOffice.net samples

SlovakTech.com

Outlook MVP David Lee

Repair PST

Convert an OST to PST

Repair damaged PST file

Repair large PST File

Remove password from PST

Merge Two Data Files

Sync & Share Outlook Data

  • Share Calendar & Contacts
  • Synchronize two computers
  • Sync Calendar and Contacts Using Outlook.com
  • Sync Outlook & Android Devices
  • Sync Google Calendar with Outlook
  • Access Folders in Other Users Mailboxes

Diane Poremsky [Outlook MVP]

Make a donation

Mail Tools

Sending and Retrieval Tools

Mass Mail Tools

Compose Tools

Duplicate Remover Tools

Mail Tools for Outlook

Online Services

Calendar Tools

Schedule Management

Calendar Printing Tools

Calendar Reminder Tools

Calendar Dates & Data

Time and Billing Tools

Meeting Productivity Tools

Duplicate Remover Tools

Productivity

Productivity Tools

Automatic Message Processing Tools

Special Function Automatic Processing Tools

Housekeeping and Message Management

Task Tools

Project and Business Management Tools

Choosing the Folder to Save a Sent Message In

Run Rules on messages after reading

Help & Suggestions

Submit Outlook Feature Requests

Slipstick Support Services

Buy Microsoft 365 Office Software and Services

Visit Slipstick Forums.

What's New at Slipstick.com

Home | Outlook User | Exchange Administrator | Office 365 | Outlook.com | Outlook Developer
Outlook for Mac | Common Problems | Utilities & Addins | Tutorials
Outlook & iCloud Issues | Outlook Apps
EMO Archives | About Slipstick | Slipstick Forums
Submit New or Updated Outlook and Exchange Server Utilities

Send comments using our Feedback page
Copyright © 2025 Slipstick Systems. All rights reserved.
Slipstick Systems is not affiliated with Microsoft Corporation.

:wpds_smile::wpds_grin::wpds_wink::wpds_mrgreen::wpds_neutral::wpds_twisted::wpds_arrow::wpds_shock::wpds_unamused::wpds_cool::wpds_evil::wpds_oops::wpds_razz::wpds_roll::wpds_cry::wpds_eek::wpds_lol::wpds_mad::wpds_sad::wpds_exclamation::wpds_question::wpds_idea::wpds_hmm::wpds_beg::wpds_whew::wpds_chuckle::wpds_silly::wpds_envy::wpds_shutmouth:
wpDiscuz

Sign up for Exchange Messaging Outlook

Our weekly Outlook & Exchange newsletter (bi-weekly during the summer)






Please note: If you subscribed to Exchange Messaging Outlook before August 2019, please re-subscribe.

Never see this message again.

You are going to send email to

Move Comment