Closing Excel (Not Workbook) from MS Project Using VBA

Hi All

I am trying to close Excel if a Worksheet does not exist, however with the code I have it is closing MS Project which I don't want it to do.  My code is enclosed here, any advice would be appreciated:

Sub TestCopy_SSCL_Plan_Compare_Metrics()
Dim t As Task
Dim percentCompleteCt, newtasksCt, removedtaskCt, earlyStartCt, earlyFinishCt, nameCt, durationCt, startCt, finishCt, baseStartCt, baseFinishCt, predCt, succCt, resNameCt As Integer
Dim xlApp As Excel.Application
Dim objRange, objRange1, objRange2
Dim xlRng As Excel.Range
Dim TkVal
Dim s As Worksheet
Dim Row As Integer
Dim LastRow As Integer
Dim NextCol As Integer
Dim xlFilename

Const xlAscending = 1
Const xlYes = 1

Call KillExcel:
xlFilename = "D:\CPP Build Template\Plan Comparisons\SSCL Plan Metrics Report.xlsx"
'Set tsks = ActiveProject.Tasks

'Set Variable values
removedtaskCt = 0
nameCt = 0
durationCt = 0
percentCompleteCt = 0
startCt = 0
finishCt = 0
baseStartCt = 0
baseFinishCt = 0
predCt = 0
succCt = 0
resNameCt = 0
earlyStartCt = 0
earlyFinishCt = 0
newtasksCt = 0
NextCol = 1

For Each t In ActiveProject.Tasks
Dim Workstream As String
Workstream = t.Text16
    If (Not t Is Nothing) And (Not t.Summary) Then

        'New Tasks added count
        If t.Text30 Like "*- current*" Then
            newtasksCt = newtasksCt + 1
        End If
        'Removed Tasks count
        If t.Text30 Like "*- previous*" Then
            removedtaskCt = removedtaskCt + 1
        End If
        'Change to Name Description
        If t.Text30 Like "Different*" Then
            If t.Text30 Like "Only*" Then
                nameCt = nameCt + 1
            End If
        End If
        'Change to Durations
        If Not t.Text25 = "Yes" Then
            If t.Text2 <> t.Text1 Then
                durationCt = durationCt + 1
            End If
        End If
        'Reduction in % complete if task started
        If t.Number3 < 0 Then
            percentCompleteCt = percentCompleteCt + 1
        End If
        'Start Date Slippage
        If t.Text6 Like "-*" Then
            GoTo StartEarly
            Else
                If t.Text6 <> "" Then
                    If t.Text6 <> "0d" Then
                        startCt = startCt + 1
                    End If
                End If
        End If
        GoTo Finishcheck

StartEarly:
        'Early Start Date
        earlyStartCt = earlyStartCt + 1

Finishcheck:
        'Finish Date Changes
        If t.Text9 Like "-*" Then
            GoTo FinishEarly
            Else
            If t.Text9 <> "0d" Then
                If t.Text9 <> "" Then
                    finishCt = finishCt + 1
                End If
            End If
        End If
        GoTo Basecheck

FinishEarly:
        earlyFinishCt = earlyFinishCt + 1

Basecheck:
        'Baseline Start Changes
        If t.Text9 <> "0d" Then
            baseStartCt = baseStartCt + 1
        End If
        'Baseline Finish Changes
        If t.Text15 <> "" Then
            If t.Text15 <> "0d" Then
                baseFinishCt = baseFinishCt + 1
            End If
        End If
        'Predecessor Changes
        If Not t.Text30 Like "Current*" Then
            If t.Text25 <> "Yes" Then
                If t.Text18 = "Different" Then
                    predCt = predCt + 1
                End If
            End If
        End If
        'Successor Changes
        If t.Text25 <> "Yes" Then
            If t.Text21 = "Different" Then
                succCt = succCt + 1
            End If
        End If
        'Resource Name Changes
        If t.Text24 <> "Equal" Then
            resNameCt = resNameCt + 1
        End If
    End If
Next t

'Subtract added tasks count to give correct duration changes figure
If newtasksCt > durationCt Then
    durationCt = durationCt - newtasksCt
End If

'Subtract added tasks count to give correct Baseline Start Date changes figure
If newtasksCt >= baseStartCt Then
    baseStartCt = baseStartCt - newtasksCt
End If

'Subtract added tasks count to give correct baseline finish date changes figure
If baseFinishCt > newtasksCt Then
    baseFinishCt = baseFinishCt - newtasksCt
End If

'Start Excel and create a new Workbook
On Error GoTo Message
Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    Workbooks.Open FileName:=xlFilename
    xlApp.Sheets(Workstream).Select

'Find first empty column starting in Row 4
TkVal = Cells(4, NextCol).Value
Do Until TkVal = ""
    TkVal = Cells(4, NextCol).Value
    If TkVal <> "" Then
        NextCol = NextCol + 1
    End If
Loop

xlApp.ActiveSheet.Cells(4, NextCol) = newtasksCt
xlApp.ActiveSheet.Cells(5, NextCol) = removedtaskCt
xlApp.ActiveSheet.Cells(6, NextCol) = nameCt
xlApp.ActiveSheet.Cells(7, NextCol) = durationCt
xlApp.ActiveSheet.Cells(8, NextCol) = percentCompleteCt
xlApp.ActiveSheet.Cells(9, NextCol) = startCt
xlApp.ActiveSheet.Cells(10, NextCol) = finishCt
xlApp.ActiveSheet.Cells(11, NextCol) = earlyStartCt
xlApp.ActiveSheet.Cells(12, NextCol) = earlyFinishCt
xlApp.ActiveSheet.Cells(13, NextCol) = baseStartCt
xlApp.ActiveSheet.Cells(14, NextCol) = predCt
xlApp.ActiveSheet.Cells(15, NextCol) = succCt
xlApp.ActiveSheet.Cells(16, NextCol) = resNameCt

With ActiveWorkbook
    SetAttr xlFilename, vbNormal
End With

Application.DisplayAlerts = False
GoTo Finished

Message:
'Set xlApp = Nothing
'With xlApp
'    Application.Quit
'End With
GoTo Finished
Finished:
'Set xlApp = Nothing
With xlApp
    ActiveWorkbook.Close
End With
MsgBox ("You have tried to open the " & Workstream & " worksheet which does not exist.  This routine will now close.  Please create the Worksheet and run this routine again.")
Application.DisplayAlerts = True
End Sub
Sub KillExcel()
Dim sKill As String

sKill = "TASKKILL /F /IM msexcel.exe"
Shell sKill, vbHide
End Sub

Kind regards

Tony

TKHussar