VBA to run macro with the most recent events

[rafaelbatalha]

Hello and good day to all!

I have a problem that i can't solve.
I have a excel sheet that run's a macro every time a close it.
The macro creates an event in Outlook calenders of diferent recipients.
The problem is that every time i open the sheet and add a new event, the macro repeats the alreday created events when i just want it to add the newest event.
I am not a programer and don's know how to code.

I have this VBA code that i found online and it works for me but i don't know how to add the conditional format to make the macro run only on the most recent events.
can anyone please help??? here is the code

Option Explicit


Sub AddAppointments()


Dim myoutlook As Object ' Outlook.Application
Dim r As Long
Dim myapt As Object ' Outlook.AppointmentItem
Dim KeyCells As Range

Set KeyCells = Range("A2:J500")

If Not Application.Intersect(KeyCells, Range("A2:J500")) _
Is Nothing Then
End If

' late bound constants
Const olAppointmentItem = 1
Const olBusy = 2
Const olMeeting = 1


' Create the Outlook session
Set myoutlook = CreateObject("Outlook.Application")


' Start at row 2
r = 2


Do Until Trim$(Cells(r, 1).Value) = ""
' Create the AppointmentItem
Set myapt = myoutlook.CreateItem(olAppointmentItem)
' Set the appointment properties
With myapt
.Subject = Cells(r, 1).Value
.Location = Cells(r, 2).Value
.Start = Cells(r, 3).Value
.End = Cells(r, 4).Value
.Recipients.Add Cells(r, 8).Value
'.Recipients.Add Cells(r, 9).Value
'.Recipients.Add Cells(r, 10).Value
.MeetingStatus = olMeeting
' not necessary if recipients are email addresses
myapt.Recipients.ResolveAll
'.AllDayEvent = Cells(r, 9).Value


' If Busy Status is not specified, default to 2 (Busy)
If Len(Trim$(Cells(r, 5).Value)) = 0 Then
.BusyStatus = olBusy
Else
.BusyStatus = Cells(r, 5).Value
End If


If Cells(r, 6).Value > 0 Then
.ReminderSet = True
.ReminderMinutesBeforeStart = Cells(r, 6).Value
Else
.ReminderSet = False
End If


.Body = Cells(r, 7).Value
.Save


.send

r = r + 1

End With
Loop
End Sub

 

[Micron]

IMO you need a helper column where you set a value that can tell the code to not create the item for those rows. Perhaps the value would be "sent" and if the code is looping over rows, then the rows with "sent" in the column should be skipped. The value would be entered at the last code line before Loop.

Please post code within code tags (vba button on posting toolbar) to maintain indentation and make it easier to read.

 

[rafaelbatalha]

IMO you need a helper column where you set a value that can tell the code to not create the item for those rows. Perhaps the value would be "sent" and if the code is looping over rows, then the rows with "sent" in the column should be skipped. The value would be entered at the last code line before Loop.

Please post code within code tags (vba button on posting toolbar) to maintain indentation and make it easier to read.

Good morning.

Firstly, thank you so much for the reply.

But, like i said, i'm not a programmer. Could you please explain to me what you mean by this sentence "... Please post code within code tags (vba button on posting toolbar) to maintain indentation and make it easier to read."
I didn't understand the full meaning.

But the idea to add a helper column sounds good and easy to implement.. something in the lines of.. every time a add a new line, in the helper column, appears the word sent.

Again, thank you so much for the reply and help

 

[Micron]

It means copy your code to clipboard, click vba icon (button) on posting toolbar. Cursor will then be between 2 code tags. Paste from clipboard. Code will now be between beginning and ending code tags like this

Sub AddAppointments()

Dim myoutlook As Object ' Outlook.Application
Dim r As Long
Dim myapt As Object ' Outlook.AppointmentItem
Dim KeyCells As Range

Set KeyCells = Range("A2:J500")

If Not Application.Intersect(KeyCells, Range("A2:J500")) _
          Is Nothing Then '<<<< this line does nothing
End If

etc. etc.
End Sub

Note how the comment I inserted looks. This is how you explain things that are not obvious or how to provide information.

 

[rafaelbatalha]

Option Explicit


Sub AddAppointments()


Dim myoutlook As Object ' Outlook.Application
Dim r As Long
Dim myapt As Object ' Outlook.AppointmentItem


' late bound constants
Const olAppointmentItem = 1
Const olBusy = 2
Const olMeeting = 1


' Create the Outlook session
Set myoutlook = CreateObject("Outlook.Application")


' Start at row 2
r = 2


Do Until Trim$(Cells(r, 1).Value) = ""
' Create the AppointmentItem
Set myapt = myoutlook.CreateItem(olAppointmentItem)
                                                                ' Set the appointment properties
With myapt
.Subject = Cells(r, 1).Value
.Location = Cells(r, 2).Value
.Start = Cells(r, 3).Value
.End = Cells(r, 4).Value
.Recipients.Add Cells(r, 8).Value              'this line will be repeated for each column that has email adresses
.MeetingStatus = olMeeting
' myapt.Recipients.ResolveAll
.AllDayEvent = Cells(r, 9).Value


' If Busy Status is not specified, default to 2 (Busy)
If Len(Trim$(Cells(r, 5).Value)) = 0 Then
.BusyStatus = olBusy
Else
.BusyStatus = Cells(r, 5).Value
End If


If Cells(r, 6).Value > 0 Then
.ReminderSet = True
.ReminderMinutesBeforeStart = Cells(r, 6).Value
Else
.ReminderSet = False
' now is the point where i would like that the code only reads new entries to the worksheet and not repeat reminders for already created items
' i think it has something to do with conditional formating
End If

Thank you for your help and most of all, for your PATIENCE.