I have some code that fires of actions to peoples tasks to remind them that
they have bits and bobs coming out - what I want it to do is go down the
spreadsheet (its around 296 rows and has merged cells for some bits) and see
if there is a month or less until the action is due and then send it but it
is giving me a headache.

The code that works for the initial task sending is as follows:

Sub Create_Task()

Dim olApp As Outlook.Application
Dim olTask As Outlook.TaskItem
Dim Subject As String
Dim Body As String
Dim wbBook As Workbook
Dim wsMain As Worksheet

Set wbBook = ThisWorkbook
Set wsMain = wbBook.Worksheets("Risk By Function")

Set olApp = New Outlook.Application
Set olTask = olApp.CreateItem(3)

With wsMain
Subject = "Non-Financial Risk Actions due"
Body = "Action due:" & vbCrLf & .Cells(5, 21).Value
Body2 = "Due date:" & vbCrLf & .Cells(5, 22).Value
End With

Application.ScreenUpdating = False

'With olTask
'.Subject = "This is the title"
'.Body = "This is the body"
'You need to change to Your own dateformat.
'.StartDate = "2002-09-11"
'.DueDate = "2002-09-14"
'.Status = olTaskWaiting
'.Importance = olImportanceHigh
'.ReminderPlaySound = True
'.Companies = "XL-Dennis"
'.Save
'End With
On Error GoTo Error_Handling

With olTask
..Subject = Subject
..Body = Body
..StartDate = Date
..DueDate = "28/04/2007"
..Importance = olImportanceHigh
..Save
..Recipients.Add ("Ruth Brink")
..Assign
..Send
End With

Set olTask = Nothing

Set olApp = Nothing

Application.ScreenUpdating = True

MsgBox "The task-list updated successfully.", vbInformation

Error_Handling:
If Err.Number = 429 And olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
Resume Next
Else
MsgBox "Error No: " & Err.Number & "; Description: "
Resume
End If


End Sub

Any help with this would be greatly appreciated.

Regards