try
i = 3
Do Until Trim(Cells(i, 1).Value) = ""
If Cells(i, 10).Value = "x" Then
Set olAppt = CalFolder.Items.Add(olAppointmentItem)
With olAppt
'Define calendar item properties
.Start = Cells(i, 5) + Cells(i, 6) '+ TimeValue("9:00:00")
.End = Cells(i, 7) + Cells(i, 8) '+TimeValue("10:00:00")
.Subject = Cells(i, 1)
.Location = Cells(i, 2)
.Body = Cells(i, 3)
.BusyStatus = olBusy
.ReminderMinutesBeforeStart = Cells(i, 9)
.ReminderSet = True
.Categories = Cells(i, 4)
.Save
' For meetings or Group Calendars
' .Send
End With
End If
i = i + 1
Loop