VBA - DueDate and Next Without For errors

[Kirexin]

Hey guys, great forum, I've been using it a lot while doing this work in Excel.

I am writing code to have Tasks in Outlook created by a huge list of tasks in an Excel document. I want to skip all the blank rows and rows of assignments that are already completed. So I am trying to make it so if the Due Date column (Column E) is NOT blank and the Actual Completion Date column (Column E) IS blank then it should create an outlook task. I have it so it is able to create outlook tasks but I am running into two problems.

1) In the section right under "For i = 9 to 25000" where it is supposed to ignore the row based on the above mentioned criteria it gives me the error "Compile error: Next without For" on the line that says Next i

2) In the section where I am trying to assign a due date near the bottom it gives me an Error 13 for the line .DueDate = DateValue(strDate)

Here is the code

Sub CheckBinding()
Dim olApp As Outlook.Application
Set olApp = New Outlook.Application
MsgBox olApp.Name
End Sub

Sub CreateTask()
Dim olApp As New Outlook.Application
Dim olName As Outlook.Namespace
Dim olFolder As Outlook.Folder
Dim olTasks As Outlook.Items
Dim olNewTask As Outlook.TaskItem
Dim strSubject As String
Dim strDate As String
Dim strBody As String
Dim reminderdate As String
Dim ws As Worksheet
Dim i As Long
Dim DueCheck As Range


Set ws = Worksheets("KPI") 'sheet where dates are
Set olName = olApp.GetNamespace("MAPI")
Set olFolder = olName.GetDefaultFolder(olFolderTasks)
Set olTasks = olFolder.Items


LR = ws.Range("C9").End(xlDown).Row 'get row for last cell in column D with value


For i = 9 To 25000 'assuming the rows have headers, so loop starts on row 2
   If Not IsEmpty(ws.Range("E", i)) And ws.Range("J", i) = "" Then
        Next i
    Else
strSubject = ws.Range("C" & i)  'takes subject from column c
strDate = ws.Range("E" & i) 'takes date from column e
strBody = ws.Range("C8") & Chr(10) & ws.Range("C" & i) & Chr(10) & Chr(10) & ws.Range("D8") & Chr(10) & ws.Range("D" & i) & Chr(10) & Chr(10) & ws.Range("F8") & Chr(10) & ws.Range("F" & i) & Chr(10) & Chr(10) & ws.Range("G8") & Chr(10) & ws.Range("G" & i) & Chr(10) & Chr(10) & ws.Range("K7") & Chr(10) & ws.Range("K" & i)
Set olNewTask = olTasks.Add(olTaskItem) 'delete task if it exists 'an error is generated if task doesn't exist

On Error Resume Next
olTasks.Item (strSubject)
If Err.Number = 0 Then
olTasks.Item(strSubject).Delete
End If
On Error GoTo 0
'create new task

With olNewTaskthat
Subject = strSubject
.Importance = olImportanceNormal
.DueDate = DateValue(strDate)
.Body = strBody
.ReminderSet = True
.Save
End With
    End If
Next i
End Sub

Sub CreateOutlookTask()
End Sub

 

[BiocideJ]

Your description was a bit vague (and contradictory), but I believe this may be what you are looking for.

Sub CreateTask()
Dim olApp As New Outlook.Application
Dim olName As Outlook.Namespace
Dim olFolder As Outlook.Folder
Dim olTasks As Outlook.Items
Dim olNewTask As Outlook.TaskItem
Dim strSubject As String
Dim strDate As String
Dim strBody As String
Dim reminderdate As String
Dim ws As Worksheet
Dim i As Long
Dim DueCheck As Range

Set ws = Worksheets("KPI") 'sheet where dates are
Set olName = olApp.GetNamespace("MAPI")
Set olFolder = olName.GetDefaultFolder(olFolderTasks)
Set olTasks = olFolder.Items

LR = ws.Range("C9").End(xlDown).Row 'get row for last cell in column D with value

For i = 9 To 25000 'assuming the rows have headers, so loop starts on row 2
   If Not IsEmpty(ws.Range("E" & i)) And ws.Range("J" & i) = "" Then
        
        strSubject = ws.Range("C" & i)  'takes subject from column c
        strDate = ws.Range("E" & i) 'takes date from column e
        strBody = ws.Range("C8") & Chr(10) & ws.Range("C" & i) & Chr(10) & Chr(10) & ws.Range("D8") & Chr(10) & ws.Range("D" & i) & Chr(10) & Chr(10) & ws.Range("F8") & Chr(10) & ws.Range("F" & i) & Chr(10) & Chr(10) & ws.Range("G8") & Chr(10) & ws.Range("G" & i) & Chr(10) & Chr(10) & ws.Range("K7") & Chr(10) & ws.Range("K" & i)
        Set olNewTask = olTasks.Add(olTaskItem) 'delete task if it exists 'an error is generated if task doesn't exist
        
        On Error Resume Next
        olTasks.Item (strSubject)
        If Err.Number = 0 Then
        olTasks.Item(strSubject).Delete
        End If
        On Error GoTo 0
        'create new task
        
        With olNewTask
            Subject = strSubject
            .Importance = olImportanceNormal
            .DueDate = DateValue(strDate)
            .Body = strBody
            .ReminderSet = True
            .Save
        End With
    End If
Next i
End Sub

 

[Kirexin]

Thanks BiocideJ. It is picking up the correct days for the due date but it is still saying error 13. I think that when the loop gets to a blank cell it is trying to read it as a date and it isn't work. What do you think?

 

[Kirexin]

I've tried a number of ways for it to skip the ranges where the Due Date (column E) are blank but I can't get it to work. I can remove the duedate part and it runs fine except it obviously doesn't have a duedate in outlook or I can leave it in and it works fine until it encounters the first blank cell in the due date column.

 

[BiocideJ]

You really don't say what you expect to happen with a blank due date, so I am going to assume you will add the task without a Due Date.

In that case change this:
.DueDate = DateValue(strDate)

to this:
If strDate <> "" Then .DueDate = DateValue(strDate)

 

[Kirexin]

I wanted lines to be ignored if they didn't contain a due date.

 

[BiocideJ]

OK, perhaps this amendment to the IF statement will cause the test to be more reliable.
If this still doesn't work, perhaps you can better define what is in column E. (i.e. typed values, formulas, etc.)

NOTE: This code will still error out if there is a non-blank, non-date value in column E. If you expect that that will happen, let me know and I will try to make a work-around.

Sub CreateTask()
Dim olApp As New Outlook.Application
Dim olName As Outlook.Namespace
Dim olFolder As Outlook.Folder
Dim olTasks As Outlook.Items
Dim olNewTask As Outlook.TaskItem
Dim strSubject As String
Dim strDate As String
Dim strBody As String
Dim reminderdate As String
Dim ws As Worksheet
Dim i As Long
Dim DueCheck As Range
Set ws = Worksheets("KPI") 'sheet where dates are
Set olName = olApp.GetNamespace("MAPI")
Set olFolder = olName.GetDefaultFolder(olFolderTasks)
Set olTasks = olFolder.Items
LR = ws.Range("C9").End(xlDown).Row 'get row for last cell in column D with value
For i = 9 To 25000 'assuming the rows have headers, so loop starts on row 2
    strDate = ws.Range("E" & i) 'takes date from column e
    If strDate <> "" And ws.Range("J" & i) = "" Then
        
        strSubject = ws.Range("C" & i)  'takes subject from column c
        strBody = ws.Range("C8") & Chr(10) & ws.Range("C" & i) & Chr(10) & Chr(10) & ws.Range("D8") & Chr(10) & ws.Range("D" & i) & Chr(10) & Chr(10) & ws.Range("F8") & Chr(10) & ws.Range("F" & i) & Chr(10) & Chr(10) & ws.Range("G8") & Chr(10) & ws.Range("G" & i) & Chr(10) & Chr(10) & ws.Range("K7") & Chr(10) & ws.Range("K" & i)
        Set olNewTask = olTasks.Add(olTaskItem) 'delete task if it exists 'an error is generated if task doesn't exist
        
        On Error Resume Next
        olTasks.Item (strSubject)
        If Err.Number = 0 Then
        olTasks.Item(strSubject).Delete
        End If
        On Error GoTo 0
        'create new task
        
        With olNewTask
            Subject = strSubject
            .Importance = olImportanceNormal
            .DueDate = DateValue(strDate)
            .Body = strBody
            .ReminderSet = True
            .Save
        End With
    End If
Next i
End Sub