Ignore the remark that I changed the variables from global to local, the
macro crashed before I had saved the change. Also, the code is too big to
show the whole thing but i've attached the first part of it:



Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlR As Excel.Range

Sub CAM_Macro()

Dim ReportStartDate As Date
Dim ReportEndDate As Date
Dim NumberOfWeeks As Variant
Dim NumberOfMonths As Variant

Check_If_Project_Open

Check_If_Task_Selected

Get_Tasks

Call Get_Report_Dates(ReportStartDate, ReportEndDate)

Call Get_TimePhased_Values(NumberOfWeeks, NumberOfMonths, ReportStartDate,
ReportEndDate)

Open_Excel

Call Display_Selected_Data(ByVal ReportEndDate)

Call Display_Current_Period_Data(ByVal ReportStartDate, ByVal ReportEndDate,
ByVal NumberOfMonths)

Call Display_Summary_Setup(ByVal ReportStartDate, ByVal ReportEndDate)

Call Display_Monthly_Summary(ByVal NumberOfMonths, ByVal ReportStartDate,
ByVal ReportEndDate)

Call Display_Weekly_Summary(ByVal NumberOfWeeks, ByVal ReportStartDate,
ByVal ReportEndDate)

Call Display_Charts(ByVal NumberOfMonths, ByVal NumberOfWeeks, ByVal
ReportEndDate)

Call Display_Overbudget_Tasks(ByVal ReportEndDate)

Call Display_PastDue_Tasks(ByVal ReportEndDate)

End_Report

Set xlApp = Nothing
Set xlBook = Nothing
Set xlR = Nothing

End Sub
Private Sub Check_If_Project_Open()

'Procedure checks if a project file is open

On Error GoTo NoFileOpen

Dim strName As String

'If there is no active project, this will throw an error and go to the
error handler.

strName = ActiveProject.Name

Exit Sub

NoFileOpen:

MsgBox "There is no project open! Open a project and rerun the macro.",
vbCritical + R_TO_L, Title:=Application.Name

End 'End the macro

End Sub

Private Sub Check_If_Task_Selected()

'Procedure checks if a project file is open

On Error GoTo NoTaskSelected

If ActiveSelection.Tasks.Count = 1 Then

Exit Sub

ElseIf ActiveSelection.Tasks.Count 1 Then

MsgBox "You have selected more than 1 task. Select a single task and
run the macro again." _
, vbCritical + R_TO_L, Title:=Application.Name

End ' End the macro
End If

NoTaskSelected:

MsgBox "You Have Not Selected A Task!", vbCritical + R_TO_L,
Title:=Application.Name

End 'End the macro

End Sub

Private Sub Get_Tasks()
Dim N As Integer
Dim BeginningRowNumber As Integer
Dim EndRowNumber As Integer
Dim MasterTask As Task
Dim PlacementTask As Task
Dim TName As String
Dim Counter As Integer

Set MasterTask = ActiveSelection.Tasks.Item(1)
BeginningRowNumber = MasterTask.ID
Set PlacementTask = MasterTask

Do While PlacementTask.OutlineChildren.Count 0

N = PlacementTask.OutlineChildren.Count

Set PlacementTask = PlacementTask.OutlineChildren.Item(N)
TName = PlacementTask.Name

Loop

EndRowNumber = PlacementTask.ID
Counter = 1

Do While ActiveSelection.Tasks.Item(1).ID < EndRowNumber

SelectCellDown 1
Counter = Counter + 1

If ActiveSelection = 0 Then

Exit Do

End If

Loop

If ActiveSelection = 0 Then
SelectCellUp
Counter = Counter - 1
End If

If ActiveSelection.Tasks.Item(1).ID EndRowNumber Then
SelectCellUp
Counter = Counter - 1
End If
If Counter = 1 Then
Exit Sub
End If

SelectCellUp (Counter - 1), True


End Sub

Private Sub Get_Report_Dates(StartDate As Date, AsOfDate As Date)

Dim TaskStartDate As Date
Dim TaskEndDate As Date

On Error GoTo DateError

TaskStartDate = ActiveSelection.Tasks.Item(1).Start
TaskEndDate = ActiveSelection.Tasks.Item(1).Finish

OptionsCalculation Automatic:=True

StartDate = InputBox("Enter the reporting Start Date. The date should be in
the following format mm/dd/yy.", _
"Report Start Date", Format$(TaskStartDate, "Short Date"))

If Round(StartDate) < Round(TaskStartDate) Then
MsgBox "Enter a valid date greater than the Project Start Date",
vbCritical
End
End If


AsOfDate = InputBox("Enter the reporting Stop Date.", _
"Report Stop Date", Format$(TaskEndDate, "Short Date")) & " 11:59 PM"

If Round(AsOfDate) < Round(StartDate) Then
MsgBox "The reporting Stop Date must be after the reporting Start
Date.", vbCritical
End
End If

Exit Sub

DateError:

MsgBox "Invalid Date!", vbCritical
End ' End the macro

End Sub

Private Sub Get_TimePhased_Values(WeekVar As Variant, MonthVar As Variant,
StartDate As Date, AsOfDate As Date)

MonthVar = Round((((Year(AsOfDate) - Year(StartDate)) * 12) +
(Month(AsOfDate) - Month(StartDate))), 0)

WeekVar = Round((((Year(AsOfDate) - Year(StartDate)) * 52) +
(Format(AsOfDate, "ww") - Format(StartDate, "ww"))), 0)

End Sub

Private Sub Open_Excel()

If xlApp Is Nothing Then
Set xlApp = CreateObject("Excel.Application") 'Start new instance
If xlApp Is Nothing Then
MsgBox "Can't Find Excel, please try again.", vbCritical
End 'Stop, can't proceed without Excel
End If
xlApp.Visible = True
Else
Set xlR = Nothing
Set xlApp = Nothing
Set xlBook = Nothing
Set xlApp = CreateObject("Excel.Application") ' Start New Instance
If xlApp Is Nothing Then
MsgBox "Can't Find Excel, please try again.", vbCritical
End 'Stop, can't proceed without Excel
End If
xlApp.Visible = True
End If
Application.ActivateMicrosoftApp pjMicrosoftExcel

End Sub

Private Sub Display_Selected_Data(ByVal AsOfDate As Date)

Dim Proj As Project
Dim T As Task
Dim ProjectName As String

Set xlBook = xlApp.Workbooks.Add
xlApp.Calculation = xlCalculationManual ' Set Manual Calculation
xlBook.Worksheets.Add Count:=4

xlBook.Worksheets(1).Name = "Project Summary" ' Name the first worksheet

'Go to first worksheet and enter all tasks
xlBook.Worksheets(1).Select


........