2 QUESTIONS - DATE SEARCH AND OUTLOOK CALENDER

[nick_rubingh]

Hi all,

I am very new and very inexperienced, I hope someone can help me. I have 2 questions see below first one:
I want to find duplicate dates for my database, but not working. I want to show how many duplicates too.

Private Sub Textbox3_afterupdate()
Set rng = Range("E2:E3000")

Dim ws As Worksheet
Dim sToFind As String
Dim rFind As Range
Dim lr As Long 'last used rown in column BL



Set ws = Sheets("Database")
sToFind = DateValue(TextBox3.Text)

lr = ws.Range("E" & Rows.Count).End(xlUp).Row

Set rFind = ws.Range("E2:E" & lr).Find(sToFind)

If rFind Is Nothing Then
'No match
MsgBox "Geen andere aanvragen gevonden op" & Space(1) & TextBox3.Value, vbQuestion, Title:="IATA CORENDON"
Else
'Match Found
MsgBox "Andere aanvragen gevonden op :" & Space(1) & TextBox3.Value, vbQuestion, Title:="IATA CORENDON"
End If
End Sub


Also how should I add calender outlook appointments to my agenda with the date of textbox3 minus 42 days.

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Database") 'define your sheet!

Dim olApp As Object 'create outlook application
Set olApp = CreateObject("Outlook.Application")

Dim olNS As Object 'get namespace
Set olNS = olApp.GetNamespace("MAPI")

'define constants if using late binding
Const olFolderCalendar As Long = 9
Const olAppointmentItem As Long = 1

Dim olRecItems As Object 'get all appointments
Set olRecItems = olNS.GetDefaultFolder(olFolderCalendar)

Dim strFilter As String 'filter for appointments
Dim olFilterRecItems As Object 'filtered appointments


With olApp.CreateItem(olAppointmentItem)
.Subject = TextBox2.Value & Space(1) & "aanvraag verwerken in casab" & Space(1) & "vertrek" & Space(1) & TextBox3.Value
.Start = Textbox3. Value - 42
.Body = "VOER GEGEVENS IN VIA" & Chr(10) & TextBox11.Value
.AllDayEvent = True
.BusyStatus = 5
.ReminderSet = True
.Save
End With