Macro to loop through all rows of data

[Sangdrax]

Good Morning,

I have created the following macro which is supposed to loop through all the data points and create Outlook calendar entries for each line of data in my Spreadsheet.

At the moment it looks like it only enters the first line as an entry to Outlook before stopping.

What do I need to edit to make this include all rows of data?

Sub CreateAppointment()    Dim myOlApp As Outlook.Application
    Dim myItem As Outlook.AppointmentItem
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
   
    Set myOlApp = GetObject(, "Outlook.Application")
    Set ws = Sheets("Sheet1")   'Edit to your worksheet name
   
    With ws
        lastRow = .Cells(1, "A").End(xlUp).Row + 1  'Last row of data
    End With
   
    For i = 2 To lastRow  'Starting at 2 assumes column headers on row 1
        'The following line adds one appointment item for each loop
        Set myItem = myOlApp.CreateItem(olAppointmentItem)
        With myItem
            .Subject = ws.Cells(i, "A")
            .Location = ws.Cells(i, "B")
            .Body = ws.Cells(i, "C")
            .Start = ws.Cells(i, "D") + ws.Cells(i, "E")
            .End = ws.Cells(i, "F") + ws.Cells(i, "G")
            .ReminderMinutesBeforeStart = ws.Cells(i, "H")
            .Save
        End With
    Next i
End Sub

Many thanks for any assistance/suggestions you may have.

Kind Regards,

S

 

[njimack]

Sorry, ignore this post

 

[Michael M]

oops....misread question ???

 

[Sangdrax]

Does anyone have any advice regarding this?

 

[StephenCrump]

lastRow = .Cells(1, "A").End(xlUp).Row + 1 'always returns 2

Perhaps you want:

lastRow = .Cells(Rows.Count,1).End(xlUp).Row

 

[Sangdrax]

Brilliant, thank you for the reply! Works perfectly now!