Shift multiple Appointments to a different time

Change Start Time buttonThere can be various reasons why you might need to move multiple appointments or meetings at once while wanting to maintain their mutual offset such as:

  • Swapping your regular free/work day, illness, Holiday or another change of schedule
  • A sync with a mobile device or published calendar website gone wrong
  • Change of time zone and you want to move back some items to their original time rather than be recalculated based on the new time zone (your morning run, or medicine time)
  • DST madness or when the Time Zone Data Update Tool (32-bit, 64-bit) fails.

While it is easy enough to move around just a few appointments in one go, moving around a larger set is quite cumbersome. To cope with that, you can quickly move them all with the same offset with the VBA macro from this guide.


ChangeStartTime macro

Visual Basic buttonThe ChangeStartTime macro allows you to more easily and accurately change the starting time of multiple appointments at once.

By using for instance a search, you can quickly select all the appointments that you want to move based on your criteria such as a category, subject, location or the fact that it takes place today, this week, this month, etc…

Of course you can also use the macro without doing a search first and select the appointments that you want to move manually via CTRL+click and then select by how much you want to change their starting time.

ChangeStartTime macro - Select the offset type
First, select the time unit that you want to use for moving…

ChangeStartTime macro - Set the offset value
…and then by how much you want to move all selected items.

Tip:
For an overview of search commands which you can use in the calendar see the guide; Instant Search query commands reference

Quick Install

Use the following instructions to configure the macro in Outlook;

  1. Download this code-file (changestarttime.zip) or copy the code below.
  2. Open the VBA Editor (keyboard shortcut ALT+F11)
  3. Extract the zip-file and import the ChangeStartTime.bas file via File-> Import…
    If you copied the code, paste it into a new module.
  4. Sign your code so you won’t get any security prompts and the macro won’t get disabled. 
  5. Add a button for easy access to the macro or press ALT+F8 and select the macro you want to execute.

Add a button to the Ribbon or the QAT to execute the ChangeStartTime macro.
Add a button to the Ribbon or the QAT to execute the ChangeStartTime macro.

Troubleshooting

Troubleshoot buttonQ: I’m receiving a warning which states that my selection contains a recurring item and that continuing deletes all exceptions. What exactly does this mean and what do I lose?

A: When using a list view or search results, any appointment or meeting which has a recurrence pattern is only shown once for all occurrences. In other words; This item acts as template for all occurrences in the series. When you make an exception to one of these occurrences, it is also stored in in this template. However, when you change the time of the template, Outlook recalculates all occurrences and will lose any exception. This also includes any attachments or notes that you associated with these exceptions. Any attachments or notes which are stored in the template itself are kept.

To move only several occurrences of a series, select them in the Day/Week/Month view and run the macro.

To prevent recurring items from showing up in your search results, add the following to your search query;
isrecurring:no

Macro code

The following code is contained in the zip-file referenced in the Quick Install. You can use the code below for review or manual installation.

Sub ChangeStartTime()

'====================================================
' Description: Outlook macro to offset all selected
'              appointments or meetings at once.
'
' author : Robert Sparnaaij
' version: 2.0
' website: https://www.howto-outlook.com/howto/changestarttime.htm
'====================================================
    
    Dim objOL As Outlook.Application
    Dim objSelection As Outlook.Selection
    Dim objItem As Object
    Set objOL = Outlook.Application
    Set objSelection = objOL.ActiveExplorer.Selection
    
    If objSelection.Count > 0 Then
    
        'Select off-set
        Dim strTimeOffsetType As String
        
        Do While Not IsNumeric(strTimeOffsetType)
            strTimeOffsetType = InputBox("Please enter the number for the offset type that you wish to set:" _
                                    & vbNewLine & vbNewLine & _
                                    "1: Minutes" & vbNewLine & _
                                    "2: Hours" & vbNewLine & _
                                    "3: Days" & vbNewLine & _
                                    "4: Weeks" & vbNewLine & _
                                    "5: Months" & vbNewLine & _
                                    "6: Years", _
                                    "Select the offset")
            
            'Set offset-variable
            Dim strTimeOffsetVar
            Dim strTimeOffsetName
            Select Case strTimeOffsetType
                Case "1"
                    strTimeOffsetVar = "n"
                    strTimeOffsetName = "minutes"
                Case "2"
                    strTimeOffsetVar = "h"
                    strTimeOffsetName = "hours"
                Case "3"
                    strTimeOffsetVar = "d"
                    strTimeOffsetName = "days"
                Case "4"
                    strTimeOffsetVar = "ww"
                    strTimeOffsetName = "weeks"
                Case "5"
                    strTimeOffsetVar = "m"
                    strTimeOffsetName = "months"
                Case "6"
                    strTimeOffsetVar = "yyyy"
                    strTimeOffsetName = "years"
                Case ""
                    Exit Sub
                Case Else
                    Result = MsgBox("You did not enter a valid selection number.", _
                                    vbCritical, "ChangeStartTime")
            End Select
        Loop
        
        'Set offset value
        Dim strTimeOffsetValue As String
        Do While Not IsNumeric(strTimeOffsetValue)
            strTimeOffsetValue = InputBox("By how many " & strTimeOffsetName & _
                                    " do you want to move your selected appointments?" _
                                    & vbNewLine & vbNewLine _
                                    & "Enter a negative number to move it backwards.", _
                                    "Set the offset")
            If strTimeOffsetValue = "" Then
                Exit Sub
            ElseIf Not IsNumeric(strTimeOffsetValue) Then
                Result = MsgBox("No valid offset value was set." & vbNewLine & _
                            "Please enter only a numeric value.", _
                            vbCritical, "ChangeStartTime")
            End If
        Loop
        
        'Apply time offset to selected Appointments or Meetings
        Dim Appointment As AppointmentItem
        Dim RecurrenceWarning As Boolean
        RecurrenceWarning = False
        For Each objItem In objSelection
                If objItem.Class = olAppointment Then
                    Set Appointment = objItem
                                        
                    If Appointment.RecurrenceState = olApptMaster Then
                        If RecurrenceWarning = False Then
                            Result = MsgBox("Your selection contains a recurring item." _
                                        & vbNewLine & "Changing the starting time of a " _
                                        & "recurring item will remove all exceptions." _
                                        & vbNewLine & vbNewLine & "Do you wish to continue?", _
                                        vbInformation + vbYesNo, "Recurring item found")
                            If Result = vbYes Then
                                RecurrenceWarning = True
                            Else
                                Exit Sub
                            End If
                        End If
                                                
                        Dim objPattern As RecurrencePattern
                        Set objPattern = Appointment.GetRecurrencePattern
                        objPattern.StartTime = DateAdd(strTimeOffsetVar, strTimeOffsetValue, objPattern.StartTime)
                        Appointment.Save
                    Else
                        Appointment.Start = DateAdd(strTimeOffsetVar, strTimeOffsetValue, Appointment.Start)
                        Appointment.Save
                    End If
                Else
                    Result = MsgBox("Error while processing:" & vbNewLine & _
                                    "Make sure your selection only includes Calendar items.", _
                                    vbCritical, "ChangeStartTime")
                    Exit Sub
                End If
         Next

    'Oops, nothing is selected
    Else
        Result = MsgBox("No item selected. Please make a selection first.", vbCritical, "ChangeStartTime")
        Exit Sub
    End If
End Sub