Select Tasks without ActiveSelection using Project VBA - excel

Question

I take a project and export selected tasks into a Gantt chart in Excel.
The tasks that end up in the Excel chart are selected by highlighting them in Project and then running the macro. I would like for the macro to select these tasks by looking at the first and last task of that group. What I mean is I'd like to read the task names, find Task Name "A" and then process all the tasks afterwards until it hits Task Name "Z".
I tried to use the Task ID to set the ID numbers but the task number will change whenever new tasks are added to the project. I also tried using the unique ID but that won't work since there are some tasks between A and Z that have been in the project for a while so setting a specific range for that wouldn't work either.
I feel there is a simple way to do this but I just haven't stumbled upon it yet.
EDIT: Added the code below. The relevant section is just below the comment "Fill cells with Task information".
Sub ExportToExcel()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim proj As Project
Dim t As Task
Dim pj As Project
Dim pjDuration As Integer
Dim i As Integer
Dim k As Integer
Dim c As Range
Set pj = ActiveProject
Set xlApp = New Excel.Application
'AppActivate "Excel"
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Open("C:\Users\Controls\Desktop\ServiceSchedule.xlsx")
xlApp.WindowState = xlMaximized
'Set up Project Detail Headers
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Application.ScreenUpdating = False
xlSheet.Application.DisplayAlerts = False
xlSheet.UsedRange.Delete
xlSheet.Cells.Clear
xlSheet.Cells.ClearContents
'xlSheet.Cells(1, 1).Value = "Project Name"
'xlSheet.Cells(1, 2).Value = pj.Name
'xlSheet.Cells(2, 1).Value = "Project Title"
'xlSheet.Cells(2, 2).Value = pj.Title
'xlSheet.Cells(1, 4).Value = "Project Start"
'xlSheet.Cells(1, 5).Value = pj.ProjectStart
'xlSheet.Cells(2, 4).Value = "Project Finish"
'xlSheet.Cells(2, 5).Value = pj.ProjectFinish
'Set Gantt Chart Timespan
'xlSheet.Cells(1, 7).Value = "Project Duration"
pjDuration = 90
'xlSheet.Cells(1, 8).Value = pjDuration & "d"
'Set up Headers
xlSheet.Cells(4, 1).Value = "Task ID"
xlSheet.Cells(4, 2).Value = "Task Name"
xlSheet.Cells(4, 3).Value = "Name"
xlSheet.Cells(4, 4).Value = "Task Start"
xlSheet.Cells(4, 5).Value = "Task Finish"
xlSheet.Cells(4, 1).Font.Bold = True
xlSheet.Cells(4, 2).Font.Bold = True
xlSheet.Cells(4, 3).Font.Bold = True
xlSheet.Cells(4, 4).Font.Bold = True
xlSheet.Cells(4, 5).Font.Bold = True
'Freeze Rows & Columns
xlSheet.Range("F5").Select
xlSheet.Application.ActiveWindow.FreezePanes = True
'AutoFit Header columns and Hide blank rows
xlSheet.Columns("A:E").AutoFit
xlSheet.Columns("A").Hidden = True
xlSheet.Rows("1:2").Hidden = True
' Add day of the week headers for the entire Project's duration
For i = 0 To pjDuration
'If Today's Date is Sunday
If xlSheet.Application.WorksheetFunction.Weekday(Now()) = 1 Then
xlSheet.Cells(3, i + 6).Value = Now() + i
xlSheet.Cells(3, i + 6).NumberFormat = "[$-409]mmmm d, yyyy;#"
xlSheet.Cells(4, i + 6).Value = Now() + i
xlSheet.Cells(4, i + 6).NumberFormat = "ddd"
End If
'If Today's Date is Monday
If xlSheet.Application.WorksheetFunction.Weekday(Now()) = 2 Then
xlSheet.Cells(3, i + 6).Value = (Now() - 1) + i
xlSheet.Cells(3, i + 6).NumberFormat = "[$-409]mmmm d, yyyy;#"
xlSheet.Cells(4, i + 6).Value = (Now() - 1) + i
xlSheet.Cells(4, i + 6).NumberFormat = "ddd"
End If
'If Today's Date is Tuesday
If xlSheet.Application.WorksheetFunction.Weekday(Now()) = 3 Then
xlSheet.Cells(3, i + 6).Value = (Now() - 2) + i
xlSheet.Cells(3, i + 6).NumberFormat = "[$-409]mmmm d, yyyy;#"
xlSheet.Cells(4, i + 6).Value = (Now() - 2) + i
xlSheet.Cells(4, i + 6).NumberFormat = "ddd"
End If
'If Today's Date is Wednesday
If xlSheet.Application.WorksheetFunction.Weekday(Now()) = 4 Then
xlSheet.Cells(3, i + 6).Value = (Now() - 3) + i
xlSheet.Cells(3, i + 6).NumberFormat = "[$-409]mmmm d, yyyy;#"
xlSheet.Cells(4, i + 6).Value = (Now() - 3) + i
xlSheet.Cells(4, i + 6).NumberFormat = "ddd"
End If
'If Today's Date is Thursday
If xlSheet.Application.WorksheetFunction.Weekday(Now()) = 5 Then
xlSheet.Cells(3, i + 6).Value = (Now() - 4) + i
xlSheet.Cells(3, i + 6).NumberFormat = "[$-409]mmmm d, yyyy;#"
xlSheet.Cells(4, i + 6).Value = (Now() - 4) + i
xlSheet.Cells(4, i + 6).NumberFormat = "ddd"
End If
'If Today's Date is Friday
If xlSheet.Application.WorksheetFunction.Weekday(Now()) = 6 Then
xlSheet.Cells(3, i + 6).Value = (Now() - 5) + i
xlSheet.Cells(3, i + 6).NumberFormat = "[$-409]mmmm d, yyyy;#"
xlSheet.Cells(4, i + 6).Value = (Now() - 5) + i
xlSheet.Cells(4, i + 6).NumberFormat = "ddd"
End If
'If Today's Date is Saturday
If xlSheet.Application.WorksheetFunction.Weekday(Now()) = 7 Then
xlSheet.Cells(3, i + 6).Value = (Now() - 6) + i
xlSheet.Cells(3, i + 6).NumberFormat = "[$-409]mmmm d, yyyy;#"
xlSheet.Cells(4, i + 6).Value = (Now() - 6) + i
xlSheet.Cells(4, i + 6).NumberFormat = "ddd"
End If
'Color Weekend columns
xlSheet.Cells(4, i + 6).ColumnWidth = 10
If xlSheet.Application.Cells(4, i + 6).Text = "Sat" Then
For k = 1 To 100
xlSheet.Cells(4 + k, i + 6).Interior.ColorIndex = 15
Next
End If
If xlSheet.Application.Cells(4, i + 6).Text = "Sun" Then
For k = 1 To 100
xlSheet.Cells(4 + k, i + 6).Interior.ColorIndex = 15
Next
End If
Next
'Merge date cells
For i = 0 To pjDuration Step 7
xlSheet.Cells(3, i + 6).Select
xlSheet.Application.ActiveCell.Resize(1, 7).Select
With xlSheet.Application.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
xlSheet.Application.Selection.Merge
Next i
'Fill cells with Task information
Dim SearchString1 As String
Dim SearchString2 As String
SearchString1 = "Buyoffs/Service"
SearchString2 = "History"
**For Each t In ActiveSelection.Tasks
xlSheet.Cells(t.ID + 4, 1).Value = t.ID
xlSheet.Cells(t.ID + 4, 2).Value = t.Name
xlSheet.Cells(t.ID + 4, 3).Value = t.ResourceNames
xlSheet.Cells(t.ID + 4, 4).Value = t.Start
xlSheet.Cells(t.ID + 4, 4).NumberFormat = "[$-409]mm-dd-yy;#"
xlSheet.Cells(t.ID + 4, 5).Value = t.Finish
xlSheet.Cells(t.ID + 4, 5).NumberFormat = "[$-409]mm-dd-yy;#"**
'Loop to color cells to mimic Gantt chart
For i = 5 To pjDuration + 5
If t.Start <= xlSheet.Cells(4, i + 1) And t.Finish >= xlSheet.Cells(4, i + 1) Then
xlSheet.Cells(t.ID + 4, i + 1).Interior.ColorIndex = 37
With xlSheet.Cells(t.ID + 4, i + 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = 0
.Weight = xlThin
End With
End If
Next i
Next t
'Loop To Change Day Headers to Single Char Format
For i = 0 To pjDuration
With xlSheet.Cells(4, i + 6)
If .Text = "Sun" Then
.Value = "S"
ElseIf .Text = "Mon" Then
.Value = "M"
ElseIf .Text = "Tue" Then
.Value = "T"
ElseIf .Text = "Wed" Then
.Value = "W"
ElseIf .Text = "Thu" Then
.Value = "R"
ElseIf .Text = "Fri" Then
.Value = "F"
ElseIf .Text = "Sat" Then
.Value = "S"
End If
End With
xlSheet.Cells(4, i + 6).ColumnWidth = 1.5
Next
'Remove empty rows
xlSheet.Range("A5:A10000").AutoFilter 1, "<>", , , False
'Autofit Columns
xlSheet.Columns("B:E").AutoFit
xlSheet.Columns("B:B").Select
With xlSheet.Application.Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
xlSheet.Application.Selection.ColumnWidth = 50
With xlSheet.Application.Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Format Cells with Borders
xlSheet.Rows("4:4").Select
xlSheet.Application.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
xlSheet.Application.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
xlSheet.Application.Selection.Borders(xlEdgeLeft).LineStyle = xlNone
xlSheet.Application.Selection.Borders(xlEdgeTop).LineStyle = xlNone
With xlSheet.Application.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
xlSheet.Application.Selection.Borders(xlEdgeRight).LineStyle = xlNone
xlSheet.Application.Selection.Borders(xlInsideVertical).LineStyle = xlNone
xlSheet.Application.Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
xlSheet.Columns("E:E").Select
xlSheet.Application.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
xlSheet.Application.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
xlSheet.Application.Selection.Borders(xlEdgeLeft).LineStyle = xlNone
xlSheet.Application.Selection.Borders(xlEdgeTop).LineStyle = xlNone
xlSheet.Application.Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With xlSheet.Application.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
xlSheet.Application.Selection.Borders(xlInsideVertical).LineStyle = xlNone
xlSheet.Range("F4:CR4").Select
With xlSheet.Application.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
xlSheet.Application.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
xlSheet.Application.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With xlSheet.Application.Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
xlSheet.Application.Selection.Borders(xlEdgeTop).LineStyle = xlNone
With xlSheet.Application.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With xlSheet.Application.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With xlSheet.Application.Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
xlSheet.Application.Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
xlApp.Visible = True
xlBook.Save
xlSheet.Application.DisplayAlerts = True
xlSheet.Application.ScreenUpdating = True
xlSheet.Application.ActiveWindow.Zoom = 100
End Sub

Answer 1

Okay I figured something out. Not the way I initially had in mind but it worked. I used the WBS property of Project to skip any task with outline level "1". So it would start at outline level "2" which contained what I wanted. Ending the loop was easy sine I just needed an If statement to jump out of the loop when it came across that last task name.
For Each t In ActiveProject.Tasks
If t.Name = "History" Then
Exit For
End If
If t.Name = "Vacations" Then
TaskA = t.ID
End If
If t.Name = "Buyoffs/Service" Then
TaskB = t.ID
End If
If t.Name = "Buyoffs/Service" Then GoTo NextIteration
TaskOffset = TaskB - TaskA + 1
If t.Name = "Vacations" Then GoTo NextIteration
If t.Name = "Unscheduled" Then GoTo NextIteration
If InStr(1, t.WBS, "1.") Then GoTo NextIteration
xlSheet.Cells(t.ID + 4 - TaskOffset, 1).Value = t.ID
xlSheet.Cells(t.ID + 4 - TaskOffset, 2).Value = t.Name
xlSheet.Cells(t.ID + 4 - TaskOffset, 3).Value = t.ResourceNames
xlSheet.Cells(t.ID + 4 - TaskOffset, 4).Value = t.Start
xlSheet.Cells(t.ID + 4 - TaskOffset, 4).NumberFormat = "[$-409]mm-dd-yy;#"
xlSheet.Cells(t.ID + 4 - TaskOffset, 5).Value = t.Finish
xlSheet.Cells(t.ID + 4 - TaskOffset, 5).NumberFormat = "[$-409]mm-dd-yy;#"