Outlook: How to remove duplicate calendar items

Sometimes, there are some duplicate calendar items when we import events from other devices. To remove the duplicate calendar items, this tutorial introduces two different methods, one is removing one by one when the duplicates are fewer, another one is using VBA to remove all duplicates at once time.

Manually remove duplicates calendar items one by one

VBA to remove duplicates calendar items at once time

Manually remove duplicates calendar items one by one

To remove duplicate calendar items one by one, you need to list them in a specific order for viewing the duplicates clearly firstly, then remove them one by one.

1. Generally, the calendar is in a Calendar view, activate the calendar you want to remove duplicates, then click View > Change View > List.

Now the calendar has been viewed as a list.

2. Then specify a condition that you use to compare if the items are duplicate, supposing to compare if the items have the same subject. Click SUBJECT in the calendar list, then all items with the same subject are placed together.

3. Now you can remove the items which have the same subject one by one by right-clicking on the item and clicking Delete from the popping context menu.

VBA to remove duplicates calendar items at once time

Here introduces some VBA which can remove all duplicate calendar items in a calendar folder in different cases.

1. Press Alt + F11 keys to enable Microsoft Visual Basic for Applications window.

2. Click Insert > Module to create a new blank module, then copy and paste below code to the module.

VBA: remove all duplicate calendar items in one specific category

'Sub RemoveDuplicateCalendar()
'UpdatebyExtendoffice20220413
  Dim xStores As Stores
  Dim xStore As Store
  Dim xRootFolder As Folder
  Dim xFolder As Object
  Set xStores = Application.Session.Stores
  For Each xStore In xStores
    Set xRootFolder = xStore.GetRootFolder
    For Each xFolder In xRootFolder.Folders
      Call ProcessFolders(xFolder)
    Next
  Next
  Set xStores = Nothing
End Sub

Sub ProcessFolders(ByVal CurrentFld As Folder)
  Dim xDictionary As Object
  Dim i As Long
  Dim xItem As Object
  Dim xKey As String
  Dim xSubFld As Folder
  On Error Resume Next
  If CurrentFld.DefaultItemType <> olAppointmentItem Then Exit Sub
  Set xDictionary = CreateObject("Scripting.Dictionary")
  For i = CurrentFld.Items.Count To 1 Step -1
    Set xItem = CurrentFld.Items.Item(i)
    'change categories as you need in below script
    If xItem.Categories = "date" Then
    'change the comparing items as you need
      xKey = xItem.Subject & xItem.Location & xItem.Body & xItem.Categories
      If xDictionary.Exists(xKey) = True Then
        xItem.Delete
      Else
        xDictionary.Add xKey, True
      End If
    End If
  Next i
  For Each xSubFld In CurrentFld.Folders
    ProcessFolders xSubFld
  Next
End Sub

In this VBA, it will remove all duplicates in “date” this category by comparing the subject, location, body and category, you can change them as you need.

3. then press F5 key or click Run to run the code, a dialog Macros pops out, choose RemoveDuplicateCalendar and click Run  .

Then the duplicate items in the “date” category have been removed.

VBA: remove all duplicate calendar items across categories

Sub RemoveDuplicateCalendar()
'UpdatebyExtendoffice20220413
  Dim xStores As Stores
  Dim xStore As Store
  Dim xRootFolder As Folder
  Dim xFolder As Object
  Set xStores = Application.Session.Stores
  For Each xStore In xStores
    Set xRootFolder = xStore.GetRootFolder
    For Each xFolder In xRootFolder.Folders
      Call ProcessFolders(xFolder)
    Next
  Next
  Set xStores = Nothing
End Sub

Sub ProcessFolders(ByVal CurrentFld As Folder)
  Dim xDictionary As Object
  Dim i As Long
  Dim xItem As Object
  Dim xKey As String
  Dim xSubFld As Folder
  On Error Resume Next
  If CurrentFld.DefaultItemType <> olAppointmentItem Then Exit Sub
  Set xDictionary = CreateObject("Scripting.Dictionary")
  For i = CurrentFld.Items.Count To 1 Step -1
    Set xItem = CurrentFld.Items.Item(i)
    'change the comparing items as you need
      xKey = xItem.Subject & xItem.Location & xItem.Body & xItem.Categories
      If xDictionary.Exists(xKey) = True Then
        xItem.Delete
      Else
        xDictionary.Add xKey, True
      End If
  Next i
  For Each xSubFld In CurrentFld.Folders
    ProcessFolders xSubFld
  Next
End Sub

Run this code, all duplicates which are at the same subject, location, body, category in each category have been removed.

Note: Above VBA works in calendar folder includes subfolder.

---

Kutools for Outlook - Brings 100 Advanced Features to Outlook, and Make Work Much Easier!

• Auto CC/BCC by rules when sending email; Auto Forward Multiple Emails by custom; Auto Reply without exchange server, and more automatic features...
• BCC Warning - show message when you try to reply all if your mail address is in the BCC list; Remind When Missing Attachments, and more remind features...
• Reply (All) With All Attachments in the mail conversation; Reply Many Emails in seconds; Auto Add Greeting when reply; Add Date into subject...
• Attachment Tools: Manage All Attachments in All Mails, Auto Detach, Compress All, Rename All, Save All... Quick Report, Count Selected Mails...
• Powerful Junk Emails by custom; Remove Duplicate Mails and Contacts... Enable you to do smarter, faster and better in Outlook.

Read More... Download Now...