Maybe:

Option Explicit

Private Sub CommandButton1_Click()
If Not ThisWorkbook.Name = "LD TOOL v2.xlsm" Then
' Create the Outlook session
    Set myOutlook = CreateObject("Outlook.Application")

    ' Start at row 5
    r = 6
Application.ScreenUpdating = False
    Do Until Trim(Cells(r, 1).Value) = ""
        If Cells(r, 9).Value <> "" Then
            ' Create the AppointmentItem
            Set myApt = myOutlook.createitem(1)
            ' Set the appointment properties
            myApt.Subject = Cells(r, 1).Value
            myApt.Start = Cells(r, 9).Value
            myApt.Location = Cells(r, 10).Value
            myApt.Duration = Cells(r, 11).Value
            ' If Busy Status is not specified, default to 2 (Busy)
            If Trim(Cells(r, 12).Value) = "" Then
                myApt.BusyStatus = 2
            Else
                myApt.BusyStatus = Cells(r, 12).Value
            End If
            If Cells(r, 13).Value > 0 Then
                myApt.ReminderSet = True
                myApt.ReminderMinutesBeforeStart = Cells(r, 13).Value
            Else
                myApt.ReminderSet = False
            End If
            myApt.Body = Cells(r, 14).Value
            myApt.Save
            r = r + 1
        End If  'Cells(r, 9).Value <> ""
    Loop    'Trim(Cells(r, 1).Value) = ""
    Application.ScreenUpdating = True
End If
End Sub

Regards, TMS