'Setup all of the variables
Dim B As Object
Dim C As Integer
Dim R As Integer
Dim Rng As Range
Dim olApp As Outlook.Application
Dim olTsk As TaskItem
Dim cl As Range
Dim chkRng As Range
Dim counter As Integer
C = 0
R = 0

'Assign the row and column indexes to the variables R and C
Set B = ActiveSheet.Buttons(Application.Caller)

With B.TopLeftCell
C = .Column
R = .Row
End With

'Set Rng value to be the date cell below the button
Set Rng = ActiveSheet.Cells(R + 3, C)

'Setup Outlook
Set olApp = New Outlook.Application

'Set the range (rows and column) to search in the loop look for Due dates.
Set chkRng = Range(Cells(12, C), Cells(104, C))

'Check to see if we've already added the Tasks to Outlook
If Rng.Value = "" Then
counter = 0
'Look at each Value in the Range and add Task if a date.
For Each cl In chkRng
Set olTsk = olApp.CreateItem(olTaskItem)
If IsDate(cl.Value) Then
With olTsk
.Subject = Cells(cl.Row, 2) + " - " + Cells(3, C) + " - " + Cells(3, C + 1)
.Status = olTaskInProgress
.Importance = olImportanceHigh
.DueDate = Format(cl.Value, "mm/dd/yy")
olTsk.Save
counter = counter + 1
End With
End If
Next cl
Else
MsgBox "Tasks have already been added to Outlook"
Exit Sub
End If
MsgBox ("Tasks added to Outlook:" & counter)
'Cleanup
Set olTsk = Nothing
Set olApp = Nothing

'Stamp the date below the button - Need to build the check for this field being blank in the above loop.

Rng.Value = Date