create/assign Outlook tasks from a range of cells

I have had some help with this (thanks!) but am stuck.

Can someone add to the code below and make it so that multiple tasks, with multiple assignees, can be created from a range of cells, such as:
Column A Column B
Row 1 Task Subject Assign to
Row 2 GV LP for AZ John Brown
Row 3 GV LP for CO John Brown
Row 4 GV LP for IL Suzy Smith
Row 5 GV LP for IN Suzy Smith
Row 6 GV LP for KY Suzy Smith
Row 7 GV LP for MN Suzy Smith
Row 8 GV LP for MS Bob Barker
Row 9 GV LP for NC Bob Barker
Row 10 GV LP for NJ Bob Barker
Row 11 GV LP for NM Bob Barker
Row 12 GV LP for NV Bob Barker
Row 13 GV LP for NY Bob Barker
Row 14 GV LP for OH Bob Barker
Row 15 GV LP for SC Bob Barker
Row 16 GV LP for WV Bob Barker
(Sorry, it didn't translate well. The "GV LP for AZ" is cell A2, "John Brown" is cell B2.)

Here is the code I have so far:

Sub CreateTask()
Const olTaskItem = 3
Dim oOlookApp As Object
Dim oOlookTask As Object
Dim rng As Range
    Set oOlookApp = CreateObject("Outlook.Application")
    
    Set rng = Range("A1")
    
    While rng.Value <> ""
        Set oOlookTask = oOlookApp.CreateItem(olTaskItem)
           
        With oOlookTask
            .Subject = rng.Value
            .Save
        End With
        Set rng = rng.Offset(1)
        
    Wend
End Sub

This creates the tasks but assigns them to me.

Can anyone help?

I would also like to have a due date column, but it is not absolutely necessary.

Thanks!

David

dftf

Welcome to Exceltip forum

Please take a couple of minutes and read the Forum Rules then wrap your VBA code (Rule 3)

chrismann85

Thanks for trying to warn dftf

Thanks for the polite warnings. I am new to this stuff.

I can't find an edit button so I am reposting, hopefully in the correct manner.

Sub CreateTask()
Const olTaskItem = 3
Dim oOlookApp As Object
Dim oOlookTask As Object
Dim rng As Range
Set oOlookApp = CreateObject("Outlook.Application")

Set rng = Range("A1")

While rng.Value <> ""
Set oOlookTask = oOlookApp.CreateItem(olTaskItem)

With oOlookTask
.Subject = rng.Value
.Save
End With
Set rng = rng.Offset(1)

Wend
End Sub

I also read that I should attach a file so others can test the data without retyping. The file is named "template.xls".

Can anyone help?

Thank you!

David

Attach your file by replying to this thread, scroll down the page & click the Edit button. It's best to zip the file first.